VBA Assistance needed. trying to select a range of cells, cut, move and paste - vba

I have a spread sheet that is updated weekly. What i need to do is cut come of the cells and paste to a new location. I have never used macros or VBA before but I am getting frustrated with the amount of time I spend doing this. I know that I can use a macro but don't know how to write it.
I am trying to move the name of the hotel and resort to the left of the passengers title
R81C00 CHALET LE VALENTIN SAUZE D'OULX
MR HAYHOE 8
MR GLOVER 2
This repeats throughout the spread sheet. The number of lines between the names is dependent on information further right in the sheet.
546L
__________1 RESORT INFORMATION
__________5 SKI/S.BOARD CARRIAGE
__________8 AD L/P BRN BF 31/12/99
what I would like to do here is move these lines onto the same line as the flight number (this is the same line as passenger details) and then delete the lines with no data. this way all the details would be on the same line and then i would just need to fill down for the hotel names.
thanks in advance for any help please let me know if i haven't explained it clearly.

Trying to keep this general enough to be of use to other people, the basic process to follow would be:
find the next hotel/resort combination
find each passenger for that hotel/resort
add in the details for the other attributes
move on to the next passenger
move on to the next hotel/resort
If we start with finding the hotel/resort combination and we assume that this is on Sheet1 in column A in a single cell and that nothing else is in column A then we would need this macro:
Option Explicit
Sub main()
Dim lngCurrRow As Long
Dim lngMaxRow As Long
With ThisWorkbook.Worksheets("Sheet1")
lngMaxRow = .UsedRange.Rows.Count
For lngCurrRow = 1 To lngMaxRow
If (.Cells(lngCurrRow, 1).Value <> "") Then
MsgBox .Cells(lngCurrRow, 1).Value
End If
Next lngCurrRow
End With
End Sub
This should pop up a message box with the name of each hotel/resort in turn.
All the code does is work out how many used rows there are on the worksheet (and stores that in lngMaxRow) and then works through every used row (using lngCurrRow to keep track of which row we are on) checking the value of the cell in column A on that row (the .Cells(lngCurrRow, 1).Value part). If there is something in that cell (the (<> "" part) then it displays the value of that cell.
The more difficult case is when there is other data in column A (e.g. if the passenger names were also in column A). In that scenario, we need a way to easily recognise what is a hotel/resort combination and what is a passenger name but I don't have enough info about your current structure to determine how to do that

Related

Copy Range Excluding Blank Cells - Paste to Another Sheet

Ok, back again!
I have tried to search throught this and other forums to find a similar solution, but everything Ive found is either just different enough that I cant figure out the application to my problem, or super complex, and I cant translate it! So Im hoping someone can help me here. Thanks in advance!!
Here is the scenario. I have a database that Im needing to add data to. Quote Number, PO Number,SubSystem Part Name, Vendor, Material, Price, Qty. Etc.
Long story short, and without getting into the context of why I did it this way (mostly because I think I would botch the explaination and be more confusing than helpful!) ... I have essentially 3 tables right next to each other.
Table 1 is columns H and I. These all have a formula similar to =if(isblank(J4),"",$I$1) Where I1 is the PO Number (which will remain the same for this set of entries.)
Table 2 is a pivot table in columns J through M. Using a slicer the user can select what sub systems they need for this PO. The pivot table will repopulate with the appropriate part numbers and unique information contained in another table.
Table 3 is a regular table in columns N through R. These columns have some formulas like above that pull from a single cell (for entering the date), some pull information from another table based on information in column J via a VLOOKUP, and some information is entered manually.
That might be too much information, but better to have it and not need it eh?
So heres the goal. With a VBA macro, I want to copy the data and paste it onto another sheet, at the bottom of a database. The trick is, because that whole setup above runs based on information coming from a pivot table, the list changes length constantly. It will never be longer than a certain length (still TBD) but will almost always be shorter. I can copy the whole thing, and have it paste to another sheet below the last entry... but it pastes below the last empty cell in the database sheet. What I mean is this:
The longest the table could be would be range H4:R38 for example. So I copy that, paste it to Sheet2 starting at cell A2. Upon further inspection, we see that there is only actual data in the range H4:R11. However, when we pasted it to Sheet2 it pasted the whole range H4:R38. When I run the macro again, instead of the new data set being pasted to row A10 (the row after where the data should have ended), it pastes to something like row 36... because its pasting below all the blank cells.
I have no idea what to do or where to start. Any help would be greatly appreciated! Thanks so much!
Code I've Tried:
Dim fabricationrange As Range
Dim destination As Range
Dim LastBBUFabDatabaseRow As Long
Worksheets("Sub Systems").Range("h4:r38").Copy
With ThisWorkbook.Sheets("BBU Fab. Database")
Worksheets("bbu fab. database").Range("z" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
lastbbufabdatabserow = .Cells(.Rows.Count, 2).End(xlUp).Row = 1
Set destination = .Cells(LastBBUFabDatabaseRow, 2)
destination.Value = PasteSpecial.Values
End With
Untested but here's a brute-force approach to locating the first empty row:
set rngDest = ThisWorkbook.Sheets("BBU Fab. Database").rows(2) '<< start here
do while application.counta(rngDest) > 0
set rngDest = rngDest.offset(1, 0) 'next row
loop
Worksheets("Sub Systems").Range("H4:R38").Copy
rngDest.cells(1).PasteSpecial xlPasteValuesAndNumberFormats '<< paste to col A

VBA Excel - Find value and copy corresponding cell

I have a workbook with several sheets. The Sheet1 acts as a sort of summary of action items based on the info we enter into the other sheets.
In Sheet1, Column A is titled Tester and under that we are manually entering the defect numbers that group needs to review.
In Sheet2, we have a list of all the defects. Each defect has its own row.
Column A has all the unique defect numbers (e.g., Defect001, Defect002, Defect003).
In Column B we have a dropdown list with all the groups a defect could be assigned to (e.g., Tester, Developer, Client).
Other columns have the various details, severity, SLA times, etc. for the defect.
Right now, we enter all the info into Sheet2 and then go to Sheet1 and enter the defect numbers under the team that needs to work them.
I want to remove the manual component of all this. Instead, I want the defects entered in Sheet2 to automatically appear under their corresponding group on Sheet1.
So, on Sheet2, I have a button tied to a macro which updates various fields in the Workbook.
I want to add to that macro some functionality that will do the following:
Look at Sheet 2, Column B
For each row that has a value of Tester in Column B, go to the corresponding cell in Column A to get the defect number.
Back in Sheet 1 under the Tester column (Column A), I want each defect to be listed.
Therefore, if Sheet2 has Defect001, Defect003, and Defect005 that were all assigned to the Tester group, those values would appear in one cell under the Tester column in Sheet1.
Since some folks think I am asking them to do all the work for me, let me clarify that I am not. I just need a starting point...something to get me going in the right direction. I appreciate any code or links that would get me started down the right path.
Let me know if I need to provide more detail or information.
Thanks for all your help.
==============
As requested, here are the code snipits I have tried so far:
For i = 1 To 5000
If ActiveSheet.Cells(i, 12).Value = "Tester" Then
MsgBox "This Works"
End If
Next i
And I looked into trying to figure out how to call the info via a pivot:
Sub ListAllItemObjects()
For Each pvt In ActiveSheet.PivotTables
For Each fld In pvt.PivotFields
For Each itm In fld.PivotItems
MsgBox itm
Next itm
Next fld
Next pvt
End Sub
Came up with a solution. Probably not the best. As FindWindow was so helpful to point out, I'm not an expert in VBA.
This will probably need some further adjustment to do everything I want, but it works well enough for now.
So to find the values I wanted that correspond to any row with Tester in Column B:
Sub UpdateStatusSummary()
For i = 1 To 5000
For Each cell In ActiveSheet.Cells(1, 2)
If ActiveSheet.Cells(i, 2).Value = "Tester" Then
ThisWorkbook.Sheets("Data").Cells(i, 10).Value = ActiveSheet.Cells(i, 1).Value
End If
Next
Next i
End Sub
This Sub (which will be changed to a Private Sub) is called with a button/graphic that has the Sub assigned to it.
To get the values from the Data sheet into one cell back on Sheet1, I went with this:
Function csvRange(myRange As Range)
Dim csvRangeOutput
For Each entry In myRange
If Not IsEmpty(entry.Value) Then
csvRangeOutput = csvRangeOutput & entry.Value & ","
End If
Next
csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function
Use =csvRange(Data!J2:J5000) in the cell you want the comma separated values from the Data sheet to go in.
Could and probably will be better after I play with it for a while. If I make any significant breakthroughs or changes, I'll be sure to post them.
If anyone has any feedback or better methods, I would greatly appreciate the constructive criticism.

VBA script for grouping columns

I've come across Stackoverflow many times when I've been looking for excel VBA scripting answers, but I've come up to a wall with my searching for an answer to my problem.
I have data which I need to sort, but it needs to be row grouped first, otherwise the sorting takes away the conformity of the info.
I want to group using info on just 1 column, and have found VBA scripts which do what I want except that they group 1 row to many. (if that makes sense)
i have info a little like
a b c d
Revise blank cell info info
blank cell blank cell info info
blank cell blank cell blank cell blank cell
Revise blank cell info info
blank cell blank cell info blank cell
Revise blank cell info info
etc etc
I want to group the top 3 rows, then the next 2.
but the only VBA script I found looks down the column for the word 'revise' but then groups the cells above the word revise, not below
I hope all that makes sense
thanks for any help
BTW, I dont really have any knowledge of programming, other than what I've gained through running some macros on other projects. Hopefully I wont need telling like a 5 YO, but may need some explanations of any code specific terms
I got this VBA script which works as I described
Option Explicit
Sub Macro2()
Dim rData, rCel As Range
Set rData = Range("a1", Range("a" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
With rData
On Error Resume Next
.Rows.Ungroup
.Rows.EntireRow.Hidden = False
On Error Goto 0
End With
For Each rCel In rData
If rCel = "END" Then Exit For
If rCel <> "Revise" Then
Rows(rCel.Row).Group
rCel.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub
Here's a quick and dirty non-VBA solution, as you say you are not overly familiar with VBA.
Add a column to the right of your data, which will hold a new index that tracks each time 'Revise' is listed in column A. Starting in A2 and copied down, this will look as follows [you may need to hardcode the first entry as 1]:
=if(A2="Revise",A1+1,A1)
This will create a column which increases by 1 each time there is a new "Revise". Then just select your entire data block, right-click, and Sort by your new index column.

Find a value from a column and quickly return the row number of its cell

What I have
I have a file with part numbers and several suppliers for each part. There are 1500 parts with around 20 possible suppliers each. For the sake of simplicity let's say parts are listed in column A, with each supplier occupying a column after that. Values under the suppliers are entered manually but don't really matter.
In another sheet, I have a list of parts that is imported from an Access database. The parts list is imported, but not the supplier info. In both cases, each part appears only once.
What I want to do
I simply want to match the supplier info from the first sheet with the parts in the imported list. Right now, I have a function which goes through each part in the list with suppliers, copies the supplier information in an array, finds the part number in the imported part list (there is always a unique match) and copies the array next to it (with supplier info inside). It works. Unfortunately, the find function slows down considerably each time it is used. I know it is the culprit through various tests, and I can't understand why it slows down (starts at 200 loop iterations per second, slows down to 1 per second and Excel crashes) . I may have a leak of some sort? The file size remains 7mb throughout. Here it is:
Function LigneNum(numAHNS As String) As Integer
Dim oRange As Range, aCell As Range
Dim SearchString As String
Set oRange = f_TableMatrice.Range("A1:A1500")
SearchString = numAHNS
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'We have found the number by now:
LigneNum = aCell.Row
Exit Function
Else
MsgBox "Un numéro AHNS n'a pas été trouvé: " & SearchString
Debug.Print SearchString & " not found!"
LigneNum = 0
Exit Function
End If
End Function
The function simply returns the row number on which the value is found, or 0 if it doesn't find it which should never happen.
What I need help with
I'd like either to identify the cause of the slow down, or find a replacement for the Find method. I have used the Find before and it is the first time this happens to me. It was initially taken from Siddarth Rout's website: http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/ What is strange is that it doesn't start slow, it just becomes sluggish as it goes on.
I think using Match could work, or maybe dumping the range to search (the part numbers) into an array and trying to match these with the imported parts number list could work. I am unsure how to do it, but my question is more about which one would be faster (as long as it remains under 15 seconds I don't really care, though, but looping over 1500 items 1500 times right out of the sheet is out of the question). Would anyone suggest match over the array solution / spending more hours fixing my code?
EDIT
Here is the loop it is being called from. I don't think it is problematic:
For Each cellToMatch In rngToMatch
Debug.Print cellToMatch.Row
'The cellsToMatch's values are the numbers I want, rngToMatch is the column where they are.
For i = 2 To nbSup + 1
infoSup(i - 2) = f_TableMatrice.Cells(cellToMatch.Row, i)
Next
'infoSup contains the required supplier data now
'I call the find function here to find the row where the number appears in the imported sheet
'To copy the array nbSup on that line
LigneAHNS = LigneNum(cellToMatch.Value) 'This is the Find function
If LigneAHNS = 0 Then Exit Sub
'This loop just empties the array in the right line.
For i = LBound(infoSup) To UBound(infoSup)
f_symix.Cells(LigneAHNS, debutsuppliers + i) = infoSup(i)
Next
Next
If I replace LigneAHNS = LigneNum by LigneAHNS = 20, for example, the code executes extremely fast. The leak therefore comes from the find function itself.
Another way to do it without using the find function might be something like this. Firstly, put the part IDs and their line numbers into a scripting dictionary. These are really quick to lookup from. Like this:
Dim Dict As New Scripting.Dictionary
Dim ColA As Variant
Lastrow=range("A50000").end(xlUp).Row
ColA = Range("A1:A" & LastRow).Value
For i = 1 To LastRow
Dict.Add ColA(i, 1), i
Next i
To further optimise, you could declare the Dict as a public variable, populate it once, and refer to it many times in your lookups. I expect this would be faster than running a cells.find over a range every time you do a lookup.
For syntax of looking up items in the dictionary, refer to Looping through a Scripting.Dictionary using index/item number
You could achieve this with only Excel cell formulas and no VB if you are willing to devote a separate column to each supplier on your main parts sheet. You could then use conditional formatting to make it more visually appealing. I've tried it with 1500 rows and it's very quick. Increasing it to 5000 rows becomes noticeably slower, but you say you have only 1500 rows for now, so it should be suitable.
On Sheet 1, define a part number column and a separate column for each supplier.
Create a separate sheet for each supplier with all part numbers available from that supplier listed in column A. Make sure the rows on the supplier sheets are ordered by part number.
Name each of the supplier sheets the same as the associated column heading shown on Sheet 1.
Assign the following formula in each cell beneath each supplier column heading on Sheet 1:
=NOT(ISNA(VLOOKUP($A2,INDIRECT("'"&B$1&"'!A:A"),1,FALSE)))
The following screen cap shows this implemented along with conditional formatting to highlight which suppliers have which parts:
If you wanted to show quantities available from suppliers, then you could always have a second column (B) on the supplier sheets containing last known quantities for each part and use VLOOKUP to retrieve column B instead of A.

Take results from one sheet and move them into many other sheets

I have looked at similar answers to this question, but whatever I do I cannot get them to do what I need.
I have a daily email which has a CSV file giving call stats for our Sales team for the previous day. What I need is to put them into Excel to give trending and historical call activity for the year. Without VBA or Macros this is a very time consuming process.
The stats it gives are number of calls, and average call length (that are of any importance) I have already got VBA to calculate the total outgoing with this:
Dim Call_Number As Integer
Dim Call_Time As Date
Dim Call_Total As Date
Call_Number = .Cells(2, 6).Value
Call_Time = .Cells(2, 7).Value
Call_Total = Call_Number * Call_Time
.Cells(12, 7).Value = Call_Total
So what I need is to take the 3 cells for each sales member, and move them into the right place in their relative sheets, which are separated by name. I also need it to move into the next cell to the right if the destination cell is full, so I'm thinking I need to start the pasting process as Jan 1st and keep moving to the right until it finds blank cells. Is there a way this can be done either in a button or automatically?
I have the first sheet used as the data import sheet, where we just import the data into csv, and because its standard formatting, every day it will give it all in the right formatting.
Code I have so far. It doesn't error, but doesn't do anything:
Sub Move_Data()
Dim Dean As Worksheet
Dim Chris As Worksheet
Dim Paul As Worksheet
Dim Nigel As Worksheet
Dim Calc As Worksheet
Dim Lastrow As Long
Dim J As Long
Dim i As Long
Set Dean = ThisWorkbook.Worksheets("DEAN 822")
Set Chris = ThisWorkbook.Worksheets("CHRIS 829")
Set Paul = ThisWorkbook.Worksheets("PAULP 830")
Set Nigel = ThisWorkbook.Worksheets("NIGEL 833")
Set RUSSELL = ThisWorkbook.Worksheets("RUSSELL 835")
Set Calc = ThisWorkbook.Worksheets("Calculation Sheet")
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
End Sub
Instead of
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
I think you want
Lastrow = Range("C" & Dean.Columns.Count).End(xlUp).Row
"I also need ... in a button or automatically?"
LastCol = WshtName.Cells(CrntRow, Columns.Count).End(xlToLeft).Column
will set LastCol to the last used column in row CrntRow.
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
I am not sure what this code is attempting.
It sets Rng to C5, C6, C7, C8, ... to Cn where n is Lastrow+5. If C5, for example, if empty it copies C2 to `Calc.Cells(2, 4).
Did you mean to copy column C from worksheet Dean to column B of worksheet Calc?
If the removal of empty cells is not important then this will be faster and clearer:
Set Rng = Dean.Range(.Cells(5 ,"C"), .Cells(Lastrow ,"C"))
Rng.Copy Destination:=Calc.Cells(2, 4)
New information in response to comment
I cannot visualise either your source data or your destination data from your description so cannot give any specific advice.
Welcome to Stack Overflow. I believe this is a good place to find previously posted information and a good place to post new questions but you must follow the site rules.
Right of centre in the top bar is the Help button. Click this and read how to use this site. Learn how to post a question that will be classified as a good question and will be answered quickly and helpfully.
I believe the biggest three problems with your question are:
You ask too much. You can ask as many good questions as you wish but there should only be one issue per question.
You ask for information that is already available.
You are too vague about your requirement to permit anyone to help. You say you want to move three values per staff member. But you do not show how either the worksheet “Calculation Sheet” or the staff member worksheets are arranged. You cannot post images until you have a higher reputation but you can use the code facility to create “drawings” of the worksheets.
To avoid asking too much, you must break your requirement into small steps. The following is my attempt to identify the necessary small steps based on my guess of what you seek.
The CSV files containing staff detail arrive as attachments to a daily email. Are you manually saving those attachment? An Outlook VBA macro to save an attachment would not be difficult to write. I suggest you leave this for later but if you search Stack Overflow for “[outlook-vba] Save attachment” you will find relevant code.
The above shows how I search Stack Overflow. I start with the tag for the language and follow it with some key words or a key phrase. Sometimes it takes me a few goes to get the right search term but I rarely fail to find something interesting
How are you importing the CSV to Excel? Are you doing this manually? There are many possible VBA approaches. Try searching for “[excel-vba] xxxx” where xxxx describes your preferred approach.
I assume the structure of the CSV file is pretty simple and there is no difficulty in find information in the individual rows. You appear to know the easiest technique for finding the last row so you should have no difficulty in creating a loop that works down the rows.
How do you relate the staff member’s name in the CSV file with the name of their worksheet? In your question you have worksheet names such as "DEAN 822", "CHRIS 829" and "PAULP 830". Are these the names used in the CSV file? What happens when a new staff member joins? I doubt this happens very often but you do not want to be amending your macro when it does happen.
I do not understand your requirement for the new data to be added to the right of any existing data. There will be three values per day so with around 200 working days per year that gives 600 columns. To me that sees an awkward arrangement. I would have thought one row per day would have been more convenient.
How will you run the macro? You mention a button or automatically. I do not like buttons since I find the tool bars cluttered enough already. I prefer to use shortcut keys such as Ctrl+q. I rarely have more than one macro per workbook of this type so that works well for me. By automatically, I assume you mean the macro will run automatically when the workbook is open. I would start with the shortcut key but when you are ready look up “Events” and “Event routines”. You will find an explanation of how you can have a macro start automatically when the workbook opens.
I hope the above is of some help.