VBA macro that loops through changing sheet names - vba

So we have an instrument that generates a bunch of data but names the sheets effectively randomly. I have the easy commands to go copy, paste and sort the respective text on the excel sheets but my problem is I can't figure out how to make the list of sheets that I generate loop through all those sheets while not specifying the name in the beginning..I don't want it to loop through all sheets because I need it to overlook the first sheet...
I'm getting an error 424 Object Req'd error. Any help would be greatly appreciated.
So I set all of my integers and variables
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer
Dim compoundname As Range
Dim compoundtype As Range
Dim compoundrng As Range
x = 1
y = 3
a = 3
b = 2
y,a,b are all associated with my settings omitted from the last part.
So here I tell it that I want compound name to be the range only on the active sheet, which I think is my actual problem?
Set compoundname = Workbook.ActiveSheet.Range("A3")
Set compoundrng = Sheets("AllSheets").Range("A3:A100")
And after I've added all the sheets to the workbook, I have the loop for the names that store on the "AllSheets" worksheet
For Each ws In Worksheets
Sheets("AllSheets").Cells(x, 1) = ws.Name
x = x + 1
Next ws
Then we have to tell it to access that list:
For Each compoundtype In compoundrng.Cells
copy, paste and sort my info here
Next compoundtype

Why don't you do something like
For Each ws In Worksheets
if(ws.Name <> 'YourFirstSheetName') Then
'copy, paste and sort info here.
end if
Next ws
Edit: Updated for your comment.
If you don't care about cell formatting then don't use the copy/paste command. Just set the cell equal to the value of the other cell. That way you don't have to play around with clipboard or active sheets/cells, etc.
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")
y = 3
Worksheets("Quant Sheet").Activate
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "Quant Sheet") Then
Sheets("Quant Sheet").Cells(y, 1) = ws.Range("A3")
y = y + 1
End If
Next ws

Related

Loop through a list of Worksheets and copy paste data into summary sheet

Hello guys I am trying to loop through a list of specific worksheets that are named in a certain range and then copy paste data from those sheets into a summary sheet.
So far I have this code:
Sub MacroToDoTheWork()
Dim ws As Worksheet
Dim ZeileUntersucht As Integer
Dim ZeileEintragen As Integer
Dim sheet_name As Range
ZeileUntersucht = 17
ZeileEintragen = 2
For each sheet_name in Sheets("Frontend").Range("L21:L49")
For ZeileUntersucht = 20 To 515
If ws.Cells(ZeileUntersucht, 238).Value = "yes" Then
Worksheets("Market Place Output").Cells(ZeileEintragen, 1) = ws.Cells(ZeileUntersucht, 1)
ZeileEintragen = ZeileEintragen + 1
End If
Next ZeileUntersucht
Next sheet_name
End Sub
The For loop is working and goes through the selected sheets range to check for a criteria and pastes the values into another sheet. What I am having issues with is the For each loop. Getting this loop to work for a list of worksheets. The Frontend Range L21:L49 is the range where the worksheet names are stored.
If you need further information, please ask
You can read all your sheet names from the Range to sheet_names array.
Later, when looping through all Sheets in ThisWorkbook, you can check if current sheet in the loop matches one of the names in the array using the Match function.
Note: if you try to do it the other way, looping through the sheet names in your Sheets("Frontend").Range("L21:L49") , and then use that name of the sheet, you can get a run-time error, if the sheet name won;t be found in any of the sheets in your workbook.
Modified Code
Dim Sht As Worksheet
Dim sheet_names As Variant
' getting the sheet names inside an array
sheet_names = Application.Transpose(Sheets("Frontend").Range("L21:L49").Value)
' loop through worksheets
For Each Sht In ThisWorkbook.Sheets
' use Macth function to check if current sheet's name matches one of the sheets in your Range
If Not IsError(Application.Match(Sht.Name, sheet_names, 0)) Then
' do here your copy Paste
End If
Next Sht
I did not understand you problem exactly, but I suppose it would be fixed, if you try it like this:
For Each sheet_name In Sheets("Frontend").Range("L21:L49")
Set ws = Worksheets(sheet_name.Text)
For ZeileUntersucht = 20 To 515
If ws.Cells(ZeileUntersucht, 238).Value = "yes" Then
Worksheets("Market Place Output").Cells(ZeileEintragen, 1) = ws.Cells(ZeileUntersucht, 1)
ZeileEintragen = ZeileEintragen + 1
End If
Next ZeileUntersucht
Next sheet_name
If your idea is that the sheet_name is the name of the worksheet, then it should work.
Two ideas:
avoid using _ in variable names in VBA, some people hate it.
Why Use Integer Instead of Long?

Write on the next available cell of a given column

I have a somewhat simple macro that I have made but I am rusty as I have not coded in a few years. As simply as I can put it, I Have two different Workbooks. If the workbook I have open has a certain value (or no value), I want it to fill the other workbook("Test Template") with either "proposal or pre-proposal."
That has all been easy for me. But since the worksheet adds rows as we input data, I need it to fill those values in the next available row.
I will attach code but don't worry about the proposal stuff, I just need the range changed from a specific cell into the next available cell in the column. (if d28 is full, put in d29).
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
'copy Names from x(active):
x.Sheets("Sheet1").Range("C4").Copy
'paste to y worksheet(template):
y.Sheets("Sheet1").Range("B28").PasteSpecial
If x.Sheets("Sheet1").Range("C15") = "" Then
y.Sheets("Sheet1").Range("D28").Value = "proposal"
Else
y.Sheets("Sheet1").Range("D28").Value = "preproposal"
End If
First, you need a variable where you'll store the last used row number:
dim lngRows as long
lngRows = Cells(Rows.Count, "D").End(xlUp).Row
Then replace your lines of code where you have .Range("B28") with either .Cells(lngRows+1,2) or .Range("B"&lngRows)
The object Range offers a method called End that returns the last range on a certain direction.
Range("A1").End(xlDown) '<-- returns the last non-empty range going down from cell A1
Range("A1").End(xlUp) '<-- same, but going up
Range("A1").End(xlToRight) '<-- same, but going right
Range("A2").End(xlToLeft) '<-- same, but going left
In your case, hence, you can detect and use the last row of column B like this:
nextRow = y.Sheets("Sheet1").Range("B3").End(xlDown).Row + 1
More details:
The first Range of your column B is the header Range("B3")
You get the last filled range going down with .End(xlDown)
Specifically, you get the Row of that range
You add + 1 (cause you want the next available row
You store the row in the variable nextRow
... that you can then use like this:
y.Sheets("Sheet1").Range("B" & nextRow ).PasteSpecial
Try this
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
Dim fromWs As Worksheet
Dim toWs As Worksheet
Dim Target As Range
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
Set fromWs = x.Sheets("Sheet1")
Set toWs = y.Sheets("Sheet1")
With fromWs
Set Target = toWs.Range("b" & Rows.Count).End(xlUp)(2) '<~~next row Column B cell
Target = .Range("c4") 'Column B
If .Range("c15") = "" Then
Target.Offset(, 2) = "proposal" 'Column D
Else
Target.Offset(, 2) = "preproposal"
End If
End With
End Sub

VBA 1004 Error on Loop execution of Macro

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.

Excel VBA how to lookup values from selected cell range from another workbook?

what I am trying to do is fairly straight forward:
Select any range of cell in WorkBook A (with value in it)
Look up every single value in that selected range from an (two columns) array in WorkBook B (say A1:B10000)
Return the value from the 2nd column of the array to Workbook B back to WorkBook A to the columns immediately to the right next to the range selected in step 1.
Here is the code I have been working so far.
Sub Checker()
Dim rw As Long, x As Range
Dim extwbk As Workbook, twb As Workbook
Dim SelRange As Range
Set twb = ThisWorkbook
Set SelRange = Selection
Set extwbk = Workbooks.Open("path to the file in my harddrive")
Set x = extwbk.Worksheets("Sheet1").Range("A1:B100000")
With twb.ActiveSheet
For rw = Selection.Row To Selection.Rows.Count + rw - 1
.Cells(rw, Selection.Column + 1) = Application.VLookup(.Cells(rw, Selection.Column).Value2, x, 2, False)
Next rw
End With
Somewhere in the section part of the code something is wrong but I cannot really figure it out. Could any of you folks help?

Migrating specific columns (almost 250) from one Excel workbook to another

Migrating data from one workbook to other. In new workbook I want only specific columns (that are almost 250). As the data in Master file, is inconsistent and not in same range, so how can I extract those 250 columns? As, I am new to VBA, I have tried the code below, it's working but I have to write long code for all that 250 columns? Any help will be greatly appreciated.
Sub Data_Migration()
Dim y As Workbook
Dim x As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng As Range
Set y = ThisWorkbook
Application.ScreenUpdating = 0
Set x = Workbooks.Open("file path")
'Column Q from master file with worksheet name cba is copied in new workbook with sheet name abc and pasted in column D
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Q2:Q11443")
rng.Copy
y.Sheets("abc").Range("D1").PasteSpecial xlValues
Application.CutCopyMode = False
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Z2:Z11443")
rng.Copy
y.Sheets("abc").Range("E1").PasteSpecial xlValues
Application.CutCopyMode = False
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("AI2:AI11443")
rng.Copy
y.Sheets("abc").Range("F1").PasteSpecial xlValues
Application.CutCopyMode = False
x.Close
End sub
Paste the following code into a standard code module (by default 'Module1' but you can name it to your liking).
Sub Main()
' 21 Mar 2017
Dim WsS As Worksheet ' S = Source
Dim WbT As Workbook, WsT As Worksheet ' T = Target
Dim Cs As Long, Ct As Long ' Column numbers: Source & Target
Dim Clms As Variant
Dim i As Integer ' index for Clms
Application.ScreenUpdating = False
On Error GoTo ErrExit
' Source is the first worksheet in the active workbook:
Set WsS = ActiveWorkbook.Worksheets("Haseev")
Set WbT = Workbooks.Add(xlWBATWorksheet)
Set WsT = WbT.Worksheets(1)
WsT.Name = "Extract 250" 'name the target sheet
Clms = Array(1, 4, 8, 13) ' list column numbers < 17
For i = 0 To UBound(Clms)
CopyColumn WsS, WsT, Clms(i), Ct
Next i
For Cs = 17 To Columns("CHU").Column Step 9
CopyColumn WsS, WsT, Cs, Ct
'''' If Ct > 10 Then Exit For
Next Cs
ErrExit:
Application.ScreenUpdating = True
End Sub
Understand the code:-
Make the currently active workbook the "Source", meaning you must look at the workbook from which you are about to copy data. The code expects to find a worksheet by the name of "Haseev" in this workbook. Change the name in the code or change that entire line of code to
Set WsS = ActiveWorkbook.Worksheets(1)
That specifies the first worksheet in the workbook which makes good sense because a large workbook like yours isn't likely to have too many sheets.
The code will create a new workbook with a single sheet in it. It will name that sheet "Extract 250". Change the name in the code to something you prefer.
Next, the code will copy selected columns to the new workbook.
Clms = Array(1, 4, 8, 13)
You can specify which columns you want to copy - as many as you need, numbers separated by commas. If you don't want any, just leave the specification blank, like Clms = Array()
In the next loop every 9th column is copied, starting from column 17 to column "CHU". You can modify the "CHU". The line
'''' If Ct > 10 Then Exit For
is a leftover from my testing. You may like to use it for the same purpose. Remove the apostrophes which disable the code and the loop will stop copying after 10 columns have been copied to the new workbook.
You may notice that the above code doesn't contain any copy or paste. Instead, it calls the next sub which you should paste below the Main procedure you already copied above.
Private Sub CopyColumn(WsS As Worksheet, _
WsT As Worksheet, _
ByVal Cs As Long, _
Ct As Long)
' 21 Mar 2017
' Ct is a return Long
If Cs > 0 Then ' column number must be > 0
Ct = Ct + 1
WsS.Columns(Cs).Copy Destination:=WsT.Columns(Ct)
End If
End Sub
Basically, the Main procedure just manages the 250 plus times this sub will be called.
The output workbook will have a generic name given by Excel, like "Sheet1". You can save it under any name you wish or close it and make a new one next time you wish to look at it.
You need a For .. Next loop. Basically,
Dim C As Long
For C = 1 to 250
' enter repetitive code here
Next C
If C is your column number, you can use C as the column number instead of "A", "B", "C". Excel isn't very good at letters. It converts the A you type into 1, B to 2, C to 3 etc - up to 250.
However, it seems that you don't need consecutive columns. So, you create an array of the numbers you need.
Dim Arr As Variant
Arr = Array(1, 12, 16, 25, 32) ' list all your 250 columns.
Now, Arr(0) = 1, Arr(1) = 12, Arr(2) = 16 etc.
and you construct your loop to refer to these numbers.
Dim n As Integer
For n = 0 to Ubound(Arr) ' that the number of elements in Arr
C = Arr(n)
Debug.Print C ' this will write C in the immediate window
Next n
In this structure you can use C as the column number, like,
Set Rng = Sh.Range(Cells(3, C), Cells(11443, C))
Cells(3, C) specifies A3, if C = 1
PS Just occurred to me that you might need this, too:-
Range("ZH2").Column should return the column number for column "ZH"