Loop Through Each Worksheet in ThisWorkbook

thardin

Board Regular
Joined
Sep 29, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
Ok, I have this very complex code that works most of the time for a daily report, but isn't completely dependable.
This Macro is trying to copy columns B and L for every worksheet into 1 worksheet in a new Workbook(in columns A and B).
The problem is, sometimes all 3 worksheets are present and sometimes only 1 or 2, sometimes the worksheet names change, and sometimes come in blank, which sometimes breaks the code.
To prevent this, I think I want to use a "For Each Worksheet in ThisWorkbook" statement.
How do you recommend achieving this?

Thanks.


Code:
Function WorksheetExists(SheetName As String, lr As Long) As Boolean
    Dim ws As Worksheet
    WorksheetExists = False
  
    
        For Each ws In Worksheets
            If ws.Name = SheetName Then
                WorksheetExists = True
                Exit For
            End If
        Next
End Function

Sub UBTCopy_Copy_Columns_B_And_L_to_New_WS()
'
' UBTCopy_And_Paste Macro
'
'
    Dim ws1 As String, ws2 As String, ws3 As String

 
    Dim S As String
    Dim Ary As Variant
    Dim fname As String, DestinationFileName As String
    Dim SourceFileName As String
    

 
    SourceFileName = ejFullDate & " EdJones A Share Restrictions Voids " & My_Initials & " " & ejFullDate4 & ".xlsx"
    DestinationFileName = "529UBTREJ" & ejFullDate2 & ".xlsx"

        
    Workbooks(SourceFileName).Activate

    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3

    
    '   Find last row in column U with data
    lr = Cells(Rows.Count, "U").End(xlUp).Row
        
    
    If WorksheetExists(ws1) Then
        '   Copy data
        lr = Cells(Rows.Count, "U").End(xlUp).Row
        If lr > 3 Then
            ws1Row_Start = 2
            ws1Row_Count = Worksheets(ws1).Cells(Rows.Count, "U").End(xlUp).Row - 3
            With Worksheets(ws1).UsedRange
                Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
            'Pastes data in destination file in cell A2 Data:
            End With
              
    
            With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws1Row_Start).Resize(UBound(Ary), 2)
            .NumberFormat = "@"
            .Value = Ary
            ActiveSheet.UsedRange.EntireColumn.AutoFit
            ActiveSheet.UsedRange.EntireRow.AutoFit
            End With
        Else
            ws1Row_Start = 2
            ws1Row_Count = 0
        End If
    Else
            ws1Row_Start = 2
            ws1Row_Count = 0
    End If
        
    
    If WorksheetExists(ws2) Then
        '   Copy data
            ws2Row_Start = ws1Row_Start + ws1Row_Count
                
    ws2Row_Count = Worksheets(ws2).Cells(Rows.Count, "U").End(xlUp).Row - 3
        With Worksheets(ws2).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
       'Pastes data in destination file under WS1 Data:
      With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws2Row_Start).Resize(UBound(Ary), 2)
        .NumberFormat = "@"
        .Value = Ary
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.UsedRange.EntireRow.AutoFit
    
        
      End With
     End If

    If WorksheetExists(ws3) Then
     '   Copy data
        ws3Row_Count = Worksheets(ws3).Cells(Rows.Count, "U").End(xlUp).Row - 3
            ws3Row_Start = ws2Row_Start + ws2Row_Count
        With Worksheets(ws3).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
        'pastes data in destination file under the WS1 and WS2 data:
        With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws3Row_Start).Resize(UBound(Ary), 2)
        .NumberFormat = "@"
        .Value = Ary
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.UsedRange.EntireRow.AutoFit
    
        End With
    End If
    
    Workbooks(DestinationFileName).Activate
        lr = Cells(Rows.Count, "A").End(xlUp).Row
        Range("A2:A" & lr).Copy
  
    'Saving Account Numbers to Notepad on Desktop:
    Workbooks.Add
    '
    Range("A1").PasteSpecial Paste:=xlPasteValues
    '
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=My_Desktop & "Notepad.txt", FileFormat:=xlText
    ActiveWorkbook.SaveAs FileName:=TEMPLATES_FOLDER & "Notepad.txt", FileFormat:=xlText
    
    Application.DisplayAlerts = True
        
    ActiveWorkbook.Close False
    With ActiveWindow
        .WindowState = xlNormal
        .Width = 400
        .Height = 591.75
        .Left = 1000
        .Top = 0
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Please explain this part:
VBA Code:
    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3
What exactly are UBT_WS1, etc?
It looks like they are variables, but I do not see them being set to anything.
Are they global variables that are set somewhere else?
 
Upvote 0
Please explain this part:
VBA Code:
    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3
What exactly are UBT_WS1, etc?
It looks like they are variables, but I do not see them being set to anything.
Are they global variables that are set somewhere else?
Yes, they are constants in another module.
so on days when the WS names change, I just change it in the constant module
 
Upvote 0
Can you confirm that they are being set correctly, as you expect?

So after the block of code, add a line like this:
VBA Code:
    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3
    MsgBox "First sheet name is: " & ws1
and make sure it is returning the correct value.

Also note with code like this:
VBA Code:
    If WorksheetExists(ws1) Then
        '   Copy data
        lr = Cells(Rows.Count, "U").End(xlUp).Row
It may not be doing what you think.
This line:
VBA Code:
        lr = Cells(Rows.Count, "U").End(xlUp).Row
may NOT be finding the last row on Sheet ws1.
It is actually finding the last row on whatever sheet is the active sheet when it hits that line of code (and you have not explicitly activated WS1).

Whenever, you are working across multiple sheets, you should preface EVERY range reference with the appropriate sheet reference, to eliminate any uncertainty.

So, if you are attempting to find the last row on sheet WS1, you should change that line to:
VBA Code:
        lr = Sheets(WS1).Cells(Rows.Count, "U").End(xlUp).Row
 
Upvote 0
Can you confirm that they are being set correctly, as you expect?

So after the block of code, add a line like this:
VBA Code:
    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3
    MsgBox "First sheet name is: " & ws1
and make sure it is returning the correct value.

Also note with code like this:
VBA Code:
    If WorksheetExists(ws1) Then
        '   Copy data
        lr = Cells(Rows.Count, "U").End(xlUp).Row
It may not be doing what you think.
This line:
VBA Code:
        lr = Cells(Rows.Count, "U").End(xlUp).Row
may NOT be finding the last row on Sheet ws1.
It is actually finding the last row on whatever sheet is the active sheet when it hits that line of code (and you have not explicitly activated WS1).

Whenever, you are working across multiple sheets, you should preface EVERY range reference with the appropriate sheet reference, to eliminate any uncertainty.

So, if you are attempting to find the last row on sheet WS1, you should change that line to:
VBA Code:
        lr = Sheets(WS1).Cells(Rows.Count, "U").End(xlUp).Row
Yeah, That's another concern I was having. That is good to know.
The reason why I had that in there was because in order for a sheet to exist, lr has to be greater than 3 (because of the 3-row header) or else it's blank.
 
Upvote 0
Yeah, That's another concern I was having. That is good to know.
The reason why I had that in there was because in order for a sheet to exist, lr has to be greater than 3 (because of the 3-row header) or else it's blank.
so I need to change that too.
 
Upvote 0
Whenever, you are working across multiple sheets, you should preface EVERY range reference with the appropriate sheet reference, to eliminate any uncertainty
That's what I did with the ws1Row_Count and ws2Row_Count. and ws3Row_Count variables.
Do you have a final recommendation on how to complete this same task but using a "For Each Worksheet in ThisWorkbook" statement??
 
Upvote 0
I think I would set up two workbook object variables, one for your source workbook, and one for your destination workbook, i.e.
VBA Code:
Dim srcWB as Workbook
Dim desWB as Workbook
Dim ws as Worksheet

Set srcWB = ThisWorkbook
etc
Then you can loop through it like this:
VBA Code:
For Each ws in srcWB
   ...
Next ws
Just be sure when referencing the ranges in the For/Next loop, to include the "ws" sheet reference because looping through the worksheets does NOT actually select/activate them!
So you still need to be explicit when referencing data ranges on them.
 
Upvote 0
I think I would set up two workbook object variables, one for your source workbook, and one for your destination workbook, i.e.
VBA Code:
Dim srcWB as Workbook
Dim desWB as Workbook
Dim ws as Worksheet

Set srcWB = ThisWorkbook
etc
Then you can loop through it like this:
VBA Code:
For Each ws in srcWB
   ...
Next ws
Just be sure when referencing the ranges in the For/Next loop, to include the "ws" sheet reference because looping through the worksheets does NOT actually select/activate them!
So you still need to be explicit when referencing data ranges on them.
How do you recommend doing that if the ws names sometimes change?
I'm trying to make these macros able to run without having to go in the code so other ppl who don't know vba can run these macros.
 
Upvote 0
How do you recommend doing that if the ws names sometimes change?
I'm trying to make these macros able to run without having to go in the code so other ppl who don't know vba can run these macros.
There is nothing in that code that is worksheet name specific!
Note that it is looping through all worksheets, regardless of what their name is.
So it is already dynamic!
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top