How can i get this to gather from 3 of the 9 worksheets in my workbook?
Option Explicit
Sub CopyCCellVals()
Dim sht1 As Worksheet, sht6 As Worksheet
Dim i As Integer, lastRow As Integer, sht6Row As Integer
sht6Row = 5
Set sht1 = Worksheets("MAINGANG")
Set sht6 = Worksheets("REPAIRS")
With sht1
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 5 To lastRow
If .Cells(i, "C") = "X" Or .Cells(i, "C") = "x" Then
sht6.Cells(sht6Row, "A") = .Cells(i, "A")
sht6Row = sht6Row + 1
End If
Next
End With
End Sub
You can use Worksheets("name").select and then manipulate the data from there?
If there is something else you are trying to do please be more specific.
also this is code to loop through sheets:
Sub GetSelectedSheetsName()
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
MsgBox ws.Name
Next ws
End Sub
Your question is not very clear but I "think" you want to gather data from multiple sheets and post to one sheet.
One way to do it is to set a worksheet array and loop through it.
Here is an example I put together on a new worksheet. I added a bunch of sheets called: Hello, World, This, Is, A, Collection, Of, Sheets and this code returned 3 message boxes showing Hello, World & Collection
Sub Temp()
Dim MySheets(2) As Worksheet, X As Long
Set MySheets(0) = Worksheets("Hello"): Set MySheets(1) = Worksheets("World"): Set MySheets(2) = Worksheets("Collection")
For X = LBound(MySheets) To UBound(MySheets)
MsgBox (MySheets(X).Name)
Next
End Sub
You can use the MyWorksheets(X) object in the same way you are using sht1 but now you can loop through them by iterating X
If this is not the answer you are looking for please post back more detail of your requirements.
Also a side note, never use Integer when dimming in VBA, Always use Long. Search on this site for some great explanations of why.
Related
I'm very new to VBA. I have some code that will copy data that meets a certain criteria in one sheet to another master sheet. I have multiple other worksheets that I want to copy from into the master. How do I amend my code to do that please?
Thanks in advance.
Sub copyPaste()
Dim ws As Worksheet
Dim wt As Worksheet
Set ws = Sheets("S_Q")
Set wt = Sheets("master")
Dim i As Integer
Dim lr As Integer
lr = ws.Range("y" & Rows.Count).End(xlUp).Row
Dim lt As Long
For i = 1 To lr
lt = wt.Range("y" & Rows.Count).End(xlUp).Row
If ws.Range("bz" & i) > 14 Then
ws.Range("y" & i).EntireRow.Copy wt.Range("a" & lt + 1)
End If
Next i
End Sub
Without diving too far into the specifics of your code itself - will the criteria be the same for all worksheets you're wanting to run it on? And is the layout of the data in all of those worksheets?
If so, and if your current code is doing what you need it to do for Worksheet A and we just need to expand that to also handle Worksheets B through X, then you could get rid of your dim/set ws lines, and instead change your first line to
sub copyPaste(ws as worksheet)
This would allow you to then use a separate procedure to call this procedure for each of your worksheets that it needs to be run on. Below is an example using the worksheet from your original code:
call copyPaste(ThisWorkbook.Sheets("S_Q"))
I would put the sheets of interest to loop over in an array and loop that. I would also use Union to gather the qualifying ranges and paste in one go to be more efficient.
I would also use a helper function to retrieve the last row and add one to that to get next row.
Also, use Long rather than Integer to avoid potential overflow as there are more rows in a sheet than Integer can handle.
Option Explicit
Public Sub copyPaste()
Dim ws As Worksheet, wt As Worksheet, sheetsOfInterest(), unionRng As Range
Dim i As Long, lastRow As Long, lastRowMaster As Long
Application.ScreenUpdating = False
sheetsOfInterest = Array("Sheet1", "Sheet2", "S_Q")
Set wt = ThisWorkbook.Worksheets("master")
For Each ws In ThisWorkbook.Worksheets(sheetsOfInterest)
lastRow = GetLastRow(ws, 25)
For i = 1 To lastRow
If ws.Range("BZ" & i) > 14 Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, ws.Range("bz" & i))
Else
Set unionRng = ws.Range("BZ" & i)
End If
End If
Next i
If Not unionRng Is Nothing Then
With wt
unionRng.EntireRow.Copy .Range("A" & GetLastRow(wt, 1) + 1)
End With
End If
Set unionRng = Nothing
Next
Application.ScreenUpdating = True
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function
After trying the filter on various columns and it working on some and not others; with no apparent reasoning. I decided to rejig the spreadsheets and put the column to be filtered in the first column. This seems to be working so far.
I don't have experience using arrays in VBA and I got lost. What I try to do is the following:
In the column A I have ~15 strings (number is not fixed sometimes it is more sometimes less)
I remove duplicates and then for each name in the column A I would like to create separate sheet in the file.
I created an array to which I tried to assign each name from A with this loop:
Sub assigningvalues()
Dim i As Integer
Dim myArray(20) As Variant
Dim finalrow As Long
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
finalrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
'For i = 2 To finalrow -> I get overflow error when I use this range
For i = 2 To Cells(20, 1)
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
Cells(2, 4).Value = myArray(4)
Cells(3, 4).Value = myArray(2)
End Sub
Nevertheless values from the cells to do not assign to the array
Moreover when I try to use finalrow as range for the loop I get overflow error (It is not a big problem as there are workarounds, although it would be nice to know what I've done wrong)
Try the code below:
Option Explicit
Sub assigningvalues()
Dim i As Long
Dim myArray(20) As Variant
Dim FinalRow As Long
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Sheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
.Range("A1", .Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row in column "A"
For i = 2 To FinalRow
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
.Cells(2, 4).Value = myArray(4)
.Cells(3, 4).Value = myArray(2)
End With
End Sub
Note: you can read the contents of the Range to a 1-D Array without a For loop, using Application.Transpose, you need to change the line you define it to:
Dim myArray As Variant
and populate the entire array using:
myArray = Application.Transpose(.Range("A2:A" & FinalRow))
Try the code below:
Sub assigningvalues()
Dim myArray As Variant
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
myArray = ActiveSheet.Range("A1", Range("A1").End(xlDown))
For Each element In myArray
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = element
Next element
End Sub
NOTES: The problem with your above code was, that
ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
returned the absolut number of rows in the sheet, not the used ones. Since your array has length 20 and the sheet about 1 Mio. rows, you have an overflow. you can check this by using
Debug.Print ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
In the above code, after you remove dublicates, you again go down from A1 to the end and save the range to an array. The array myArray now contains all the cell values in your reduced range.
Now you loop over the elements with
For Each element in myArray
and create a new sheet with Workbook.Sheets.Add and assign the name my setting Sheets(index).name = element
The above code should work for you. Few remarks:
Instead of using "ActiveSheet", ThisWorkbook, etc. You should always start a Sub with this:
Dim wb As Workbook
Set wb = ThisWorkbook 'for the workbook containing the code
Set wb = Workbooks(workbookName) 'to reference an other Workbook
'And for all the sheets you are using
Dim ws As Worksheet
Set ws = wb.Sheets(sheetName) 'this way you avoid problems with multiple
workbooks that are open and active or
unactive sheets.
Can anybody give me a sense of why I'd be receiving a 1004 error on the following code?
If it's not clear, I'm trying to loop all sheets that are not my named sheet and try to select a particular range and copy and paste it to the compiled "Quant Sheet"
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer
Set ws = Worksheets("Quant Sheet")
x = 1
y = 3
a = 3
b = 2
Worksheets("Quant Sheet").Activate
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "Quant Sheet") Then
ws.Range("A3").Select
Selection.Copy
Sheets("Quant Sheet").Select
Cells(y, 1).Select
ActiveSheet.Paste
y = y + 1
End If
Next ws
You set WS as Worksheets("Quant Sheet") but then use that same variable ws to use in your loop. That may be causing the issue.
Try this:
Dim ws As Worksheet, mainWS As Worksheet
Dim x As Integer, y As Integer, a As Integer, b As Integer
Set mainWS = Worksheets("Quant Sheet")
x = 1
y = 3
a = 3
b = 2
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "Quant Sheet") Then
ws.Range("A3").Copy Destination:=mainWS.Cells(y, 1)
y = y + 1
End If
Next ws
Mainly, you want to avoid using .Select/.Activate to make sure you work more directly with the data.
Edit: FYI you can likely further make this more dynamic by not using something like y=y+1 and instead use offset, or a lastRow variable, but that's personal preference as it'll accomplish the same thing. (I'm also assuming the x, a, and b variables are used elsewhere in your macro...
As was already stated, you can't .Select a cell on a worksheet you haven't called .Activate on first - that would fix the problem, but leave you with frail & slow .Select and .Activate calls everywhere. Instead, iterate the Worksheets collection with a For Each loop, so you get a Worksheet object to work with each iteration:
Sub test()
Dim quantSheet As Worksheet, tempSheet as Worksheet
Dim i As Integer
Set quantSheet = ThisWorkbook.Worksheets("Quant Sheet")
i = 3
For Each tempSheet In ThisWorkbook.Worksheets
If tempSheet.Name <> quantSheet.Name Then
quantSheet.Cells(i, 1).Value = tempSheet.Range("A3").Value
i = i + 1
End If
Next tempSheet
End Sub
Further to the good answers and comments already provided, you can neaten up your code a lot.
Indentation is key. You can avoid loads of errors just by sticking to simple indentation
Remove of all those unused variables (unless you're using them later and haven't shown us!)
Rather than copying and pasting, set your values directly using .Value. It's quicker and better
Avoid Select and Activate as much as possible, as has already been pointed out. That includes ActiveSheet and ActiveWorkbook
Give your variables good, meaningful names and your code will almost read like a geeky VBA novel. That way you'll always know what's going on.
Post your working code on Code Review Stack Exchange for a full-blown peer review.
I've been stuck on this for a while, I could really use some help. I have this sub that searches for a column with the heading "Account" within five worksheets (B,E,L,I,T). When it finds a match, it then does a vlookup to bring the values of that entire column into another sheet in the spread (MasterTab). It works great. But I need to make it a loop so that it can do this process with an array of 550 variables (these are other column headings).
I am very new to loops and understand basic examples but this one seems complex because
I (think I) need to do a loop within a loop, because I have to loop for every mf_x_TEXT variable (the string for my match function), and also every mf_x variable (the match function itself). And since the code itself is a loop, that's three loops.
The mf_x variables rely on the mf_x_TEXT variables to work, so I don't really know how to set it up so that the loop correctly places the right TEXT variable into the right mf_x match function.
Here's my sub that works, without any attempts at getting what I'm talking about to work. If I show you my attempts at doing the loops it will just make things even more confusing. The mf_Account and mf_Account_TEXT is one example of the two sets of 550+ variables.
Sub GetInfoAltVersion()
'
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim vWSs As Variant: vWSs = Array("B", "E", "L", "I", "T")
'
Dim v As Long
Dim Mrange As Range
Dim Vrange As Range
'
With Workbooks("LBImportMacroTemplate.xlsm")
Set Mrange = Nothing
Set Vrange = Nothing
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
MsgBox lastrow
End With
'
Dim mf_Account_TEXT As String: mf_Account_TEXT = "Account"
'ETC, THERE ARE MANY MORE VARIABLES JUST LIKE THIS, BUT WITH DIFFERENT STRINGS
'
'THIS IS THE PART THAT I NEED TO LOOP FOR EACH VARIABLE
For v = LBound(vWSs) To UBound(vWSs)
If CBool(Application.CountIf(.Sheets(vWSs(v)).Range("A2:ZA2"), mf_Account_TEXT)) Then
Set Mrange = .Sheets(vWSs(v)).Range("A2:ZA2")
Set Vrange = .Sheets(vWSs(v)).Range("A:ZA")
mf_Account = Application.Match(mf_Account_TEXT, Mrange, 0)
'
For i = 2 To lastrow
wsMaster.Cells(i, 2) = Application.VLookup(wsMaster.Cells(i, 1), Vrange, mf_Account, 0)
Next i
Exit For
End If
Next v
Set Mrange = Nothing
Set Vrange = Nothing
'
End With
End Sub
One thing that could help is if I could put the application.Match function inside the vlookup function without having to make it a variable, because that would eliminate one of the needed loops. But I couldn't get the vlookup to work this way. The only way I was able to do it was do declare the match function as a variable, and then put the variable in the index_col_num section of the vlookup.
I know a programmer wouldn't write this manually 550 times, so there must be a way that is beyond my current understanding. Please help if you can, it is driving me nuts.
This will get the "variable" names from the Master Sheet. Put them all in row 1 starting in column 2. It is assumed that the value to look up in the other sheets is in the first column in both the Master Sheet and the other sheets.
If the lookup value and the column are in multiple sheets, then this will overwrite the value with the sheet listed later in your array. For instance, if lookup value "12345" and column Name "Account" are in both worksheet "B" and worksheet "T", then the value in worksheet "T" will be the one that shows up in your data. If you need a value from a different worksheet, then reorder the array to put the most important sheet last or the code will need to be modified.
Note that this is likely not the most efficient way to do this, but it should work.
Sub GetInfoAltVersion()
Dim xlWb As Workbook
Dim wsMaster As Worksheet
Dim vWSs As Variant: vWSs = Array("B", "E", "L", "I", "T")
Dim v As Long
Dim Mrange As Range
Dim Vrange As Range
Dim colName As String
Dim lastCol As Integer
Dim LastRow As Long
Dim AccountCol As Integer
Dim CurrSheet As Worksheet
Set xlWb = Workbooks("LBImportMacroTemplate.xlsm")
Set wsMaster = xlWb.Worksheets("MasterTab")
LastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row
MsgBox LastRow
lastCol = wsMaster.Cells(1, wsMaster.Columns.Count).End(xlToLeft).Column
MsgBox lastCol
For j = 2 To lastCol
colName = wsMaster.Cells(1, j).Value
For v = LBound(vWSs) To UBound(vWSs)
CurrSheet = xlWb.Sheets(vWSs(v))
If CBool(Application.CountIf(CurrSheet.Range("A2:ZA2"), colName)) Then
Set Mrange = CurrSheet.Range("A2:ZA2")
Set Vrange = CurrSheet.Range("A:ZA")
AccountCol = Application.Match(j, Mrange, 0)
'
For i = 2 To LastRow
wsMaster.Cells(i, j) = Application.VLookup(wsMaster.Cells(i, 1), Vrange, AccountCol, 0)
Next i
End If
Next v
Set Mrange = Nothing
Set Vrange = Nothing
'
Next j
End Sub
Hope this helps.
While I can't authoritatively answer VBA-specific questions, I can provide a general programming suggestion.
If the values you want to iterate through are already in your worksheets, you could collect the values from the worksheets. If not, you could create another worksheet to store the list of values.
If for some reason you can't externalize the data, you can simply create a single variable (or constant) to store the values in a collection. Depending on your use case, you can use a list (sequential) or map (key-value pairs) type to store them. This would enable you to iterate over the list or the set of keys, respectively.
i'm trying to make a macro which:
goes through a table
looks if value in column B of that table has a certain value
if it has, copy that row to a range in an other worksheet
The result is similar to filtering the table but I want to avoid hiding any rows
I'm kinda new to vba and don't really know where to start with this, any help much appreciated.
That is exactly what you do with an advanced filter. If it's a one shot, you don't even need a macro, it is available in the Data menu.
Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
, Unique:=False
Try it like this:
Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
Selects are slow and unnescsaary. The following code will be far faster:
Sub CopyRowsAcross()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
For i = 2 To ws1.Range("B65536").End(xlUp).Row
If ws1.Cells(i, 2) = "Your Critera" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
Next i
End Sub
you are describing a Problem, which I would try to solve with the VLOOKUP function rather than using VBA.
You should always consider a non-vba solution first.
Here are some application examples of VLOOKUP (or SVERWEIS in German, as i know it):
http://www.youtube.com/watch?v=RCLUM0UMLXo
http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx
If you have to make it as a macro, you could use VLOOKUP as an application function - a quick solution with slow performance - or you will have to make a simillar function yourself.
If it has to be the latter, then there is need for more details on your specification, regarding performance questions.
You could copy any range to an array, loop through this array and check for your value, then copy this value to any other range. This is how i would solve this as a vba-function.
This would look something like that:
Public Sub CopyFilter()
Dim wks As Worksheet
Dim avarTemp() As Variant
'go through each worksheet
For Each wks In ThisWorkbook.Worksheets
avarTemp = wks.UsedRange
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
'check in the first column in each row
If avarTemp(i, LBound(avarTemp, 2)) = "XYZ" Then
'copy cell
targetWks.Cells(1, 1) = avarTemp(i, LBound(avarTemp, 2))
End If
Next i
Next wks
End Sub
Ok, now i have something nice which could come in handy for myself:
Public Function FILTER(ByRef rng As Range, ByRef lngIndex As Long) As Variant
Dim avarTemp() As Variant
Dim avarResult() As Variant
Dim i As Long
avarTemp = rng
ReDim avarResult(0)
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
If avarTemp(i, 1) = "active" Then
avarResult(UBound(avarResult)) = avarTemp(i, lngIndex)
'expand our result array
ReDim Preserve avarResult(UBound(avarResult) + 1)
End If
Next i
FILTER = avarResult
End Function
You can use it in your Worksheet like this =FILTER(Tabelle1!A:C;2) or with =INDEX(FILTER(Tabelle1!A:C;2);3) to specify the result row. I am sure someone could extend this to include the index functionality into FILTER or knows how to return a range like object - maybe I could too, but not today ;)