2016 Excel VBA Loop Multiple Worksheets Based on Search Criteria and Copy

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Hello;

I have this VBA code that searches a sheet called Data, which is based on search criteria that is located in Cell P2 on Sheet VRF and copies it under P2. It works fine. However, I would like to search all sheets and copy. I found this code on the Microsoft Support webpage to loop through multiple worksheets, but I am not sure on how to combine them. If someone could help me, that would be greatly appreciated.

VBA Code:
Sub SearchData()
Dim employeename As String
Dim finalrow As Integer
Dim i As Integer

Sheets("VRF").Range("P3:Z100").ClearContents
employeename = Sheets("VRF").Range("P2").Value
finalrow = Sheets("Data").Range("A1000").End(xlUp).Row

For i = 2 To finalrow
If Cells(i, 1) = employeename Then
Range(Cells(i, 2), Cells(i, 11)).Copy
Sheets("VRF").Range("P100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i

End Sub
VBA Code:
Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ActiveWorkbook.Worksheets(I).Name

         Next I

      End Sub
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Takae

Well-known Member
Joined
Jul 1, 2015
Messages
723
Hope this helps.

VBA Code:
Sub SearchData()
Dim employeename As String
Dim w, VRFws As Worksheet

Set VRFws = Sheets("VRF")

With VRFws
    .Range(.Range("P3"), .Range("P3").SpecialCells(xlLastCell).Offset(1, 0)).ClearContents
    employeename = .Range("P2").value
End With

For Each w In Worksheets
    If w.Name <> "VRF" Then
        w.Range("A1").AutoFilter , field:=1, Criteria1:=employeename
        If WorksheetFunction.Subtotal(3, w.Range("A:A")) > 1 Then
            w.Range("A1").CurrentRegion.Offset(1, 0).Resize(w.Rows.Count - 1).Copy VRFws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        w.Range("A1").AutoFilter
    End If
Next

End Sub
 

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Hi Takae

Thank you for your quick response, and for you to rewrite it – much love. Your code does run, but if I run it again, it gives an error “application-defined or object error” on line:

VBA Code:
.Range(.Range("P3"), .Range("P3").SpecialCells(xlLastCell).Offset(1, 0)).ClearContents
 

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
update: I changed this
VBA Code:
.Range(.Range("P3"), .Range("P3").SpecialCells(xlLastCell).Offset(1, 0)).ClearContents
to this
VBA Code:
Sheets("VRF").Range("A1:B250").ClearContents

And depending what I pick is now giving an error for w.Range("A1").CurrentRegion.Offset(1, 0).Resize(w.Rows.Count - 1).Copy VRFws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
excel error-1004.png
 

Takae

Well-known Member
Joined
Jul 1, 2015
Messages
723

ADVERTISEMENT

wow, I'm sorry I made a lot of mistakes.
".Range("P3:Z100").ClearContents" I changed this line. and pasted data too.
Please try this again.

VBA Code:
Sub SearchData()
Dim employeename As String
Dim w, VRFws As Worksheet

Set VRFws = Sheets("VRF")

With VRFws
    '.Range("A1:B250").ClearContents
    .Range("P3:Z100").ClearContents
    employeename = .Range("P2").value
End With

For Each w In Worksheets
    If w.Name <> "VRF" Then
        w.Range("A1").AutoFilter , field:=1, Criteria1:=employeename
        If WorksheetFunction.Subtotal(3, w.Range("A:A")) > 1 Then
            w.Range(w.Range("B2"), w.Cells(Rows.Count, 11).End(xlUp)).Copy VRFws.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0)
        End If
        w.Range("A1").AutoFilter
    End If
Next

End Sub
 

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
This is hard to explain on what is going on. Depending on what I pick from P2, it changes where and how it is displayed on VRF. P2 is a Data Validation List that is coming from Sheet4, which is hidden. I thought maybe since it is hidden, the search function would ignore it, maybe it is not. I uploaded the file to filebin, so you can see what i am talking about.Excel Book
 

Takae

Well-known Member
Joined
Jul 1, 2015
Messages
723

ADVERTISEMENT

I added a line to avoid Sheet4.
VBA Code:
Sub SearchData()
Dim employeename As String
Dim w, VRFws As Worksheet

Set VRFws = Sheets("VRF")

With VRFws
    .Range("P3:Z100").ClearContents
    employeename = .Range("P2").Value
End With

For Each w In Worksheets
    If w.Name <> "VRF" And w.Name <> "Sheet4" Then
        w.Range("A1").AutoFilter , field:=1, Criteria1:=employeename
        If WorksheetFunction.Subtotal(3, w.Range("A:A")) > 1 Then
            w.Range(w.Range("B2"), w.Cells(Rows.Count, 11).End(xlUp)).Copy VRFws.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0)
        End If
        w.Range("A1").AutoFilter
    End If
Next
End Sub

and you can use sheet module of VRFsheet. Automatically display the results whenever P2 changes.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim w, VRFws As Worksheet
    
    If Intersect(Target, Range("P2")) Is Nothing Then
        Exit Sub
    Else
        Set VRFws = Sheets("VRF")
        Application.EnableEvents = False
        VRFws.Range("P3:Z100").ClearContents
        
        For Each w In Worksheets
            If w.Name <> "VRF" And w.Name <> "Sheet4" Then
                w.Range("A1").AutoFilter , field:=1, Criteria1:=Target.Value
                If WorksheetFunction.Subtotal(3, w.Range("A:A")) > 1 Then
                    w.Range(w.Range("B2"), w.Cells(Rows.Count, 11).End(xlUp)).Copy VRFws.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0)
                End If
                w.Range("A1").AutoFilter
            End If
        Next
    End If
    Application.EnableEvents = True
End Sub
 
Solution

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Thanks again. The display is off when counting/coping to P3. Hopefully this makes sense. I displayed it in a Table on how it looks on Sheet VRF.

Kim/Bob look same

PQ
Location


Ted

PQ
Location
LaptopMain
Location
LaptopMain


Changed “B2” to “A2” - I change the line to this
VBA Code:
w.Range(w.Range("A2"), w.Cells(Rows.Count, 11).End(xlUp)).Copy VRFws.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0)

This is how I would like it, It starts to display by row and look at the other sheets, not sure what is causing it to be different for each selection in P2.

Ted

PQR
Employeetypelocation
tedlaptopmain
Employeetypelocation
tedlaptopmain


Kim/bob look the same

PQR
Employeetypelocation
Employeetypelocation
 

crazzyapple

New Member
Joined
Jan 22, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Good point, thank you Takae. I changed w.Cells(Rows.Count, 11) to w.Cells(Rows.Count, 3) and everything is good. I appreciate your help and your brain.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,653
Messages
5,626,101
Members
416,161
Latest member
David1966Lewis

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
Top