Beginner Help - How to filter more then one worksheet

[KathrynMcG]

Hi,

I am a total beginner to this, having only learnt about VBA in the last 24 hours.

However, this is what i'm trying to do:

We have a workbook with several worksheets. Each one represents a different area of our factory. Currently they are used for auditing purposes, with questions, and a score given and jobs listed to be fixed againt each question.

What we want to be able to do is to assign a code to each job (or row) on each worksheet (e.g. ENG for engineers) for who needs to fix it, and then have those jobs automatically populate on a different worksheet for each "person". So one for ENG jobs and QA jobs etc.

I googled it and borrowed some coding from another person who wanted a similar thing.

I have got it to work, but only for one worksheet, i.e. it will only search the sheet ("Lab & Offices") when I ultimately want it to seach all sheets.

Is there a way to define all sheets in workbook, or a range of sheets? Being a complete beginner, i'm sure it must be easy but i just don't know the correct coding for it.

This is what I have:

Option Explicit
Private Sub Worksheet_Activate()
Dim LR As Long

Me.UsedRange.Offset(1).ClearContents 'clear existing data

With Sheets("Lab & Offices")
.AutoFilterMode = False 'remove any prior filtering
.Rows(1).AutoFilter 'activate autofilter
.Rows(1).AutoFilter 6, ">=QA" 'filter column F for QA
LR = .Range("A" & .Rows.Count).End(xlUp).Row 'is any data visible?
If LR > 1 Then
.Range("A2:G" & LR).Copy Range("A2") 'copy any data visible to report
Else
Range("A2") = "no data found" 'if none, give that message
End If
.AutoFilterMode = False 'turn off autofilter

End With

End Sub


What I want to know is how to get it to look further than the "Lab & Offices" sheet (which is sheet 11). I want to look through sheets 2 to 11 for references to QA in column 6 (or F).

Appreciate any help!! (p.s. using Excel 2010)

 

[Michael M]

Hi Kathryn and welcome to the Board
Try this...untested

Option Explicit
Private Sub Worksheet_Activate()
Dim LR As Long, ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
    ws.activate
        Me.UsedRange.Offset(1).ClearContents 'clear existing data
        With ActiveSheet
            .AutoFilterMode = False 'remove any prior filtering
            .Rows(1).AutoFilter 'activate autofilter
            .Rows(1).AutoFilter 6, ">=QA" 'filter column F for QA
            LR = .Range("A" & .Rows.Count).End(xlUp).Row 'is any data visible?
                If LR > 1 Then
                    .Range("A2:G" & LR).Copy Range("A2") 'copy any data visible to report
                    Else
                    Range("A2") = "no data found" 'if none, give that message
                End If
        .AutoFilterMode = False 'turn off autofilter
        End With
Next ws
Application.ScreenUpdating = True
End Sub

 

[KathrynMcG]

Thanks for that Michael M.

It seems to have a problem with this line:

.Rows(1).AutoFilter 6, ">=QA" 'filter column F for QA

A dialogue box comes up and says "Run-time error "1004": Autofilter method of Range class failed". When I debug it highlights the above line in the coding.

Do you have any ideas why this might be so? I have F columns on each sheet, which is column 6 where the tag "QA" goes. I'm confused as to why it doesn't like it

 

[Michael M]

Did a small trial section, which seemed to work OK
Shouldn't this line have a sheet reference as well ??

.Range("A2:G" & LR).Copy Sheets("Report").Range("A2") 'copy any data visible to report

Private Sub Worksheet_Activate()
Dim LR As Long, ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
    ws.Activate
        ws.UsedRange.Offset(1).ClearContents 'clear existing data
        With ActiveSheet
            .AutoFilterMode = False 'remove any prior filtering
            .Rows(1).AutoFilter 'activate autofilter
            .Rows(1).AutoFilter 6, ">=QA" 'filter column F for QA
            LR = .Range("A" & .Rows.Count).End(xlUp).Row 'is any data visible?
                If LR > 1 Then
                    .Range("A2:G" & LR).Copy Range("A2") 'copy any data visible to report
                    Else
                    Range("A2") = "no data found" 'if none, give that message
                End If
        .AutoFilterMode = False 'turn off autofilter
        End With
Next ws
Application.ScreenUpdating = True
End Sub

 

[KathrynMcG]

Thanks again, but it still doesn't like that line I showed before. And now it seems to delete all the text from every sheet in the workbook except my job list/report sheet. And the report sheet still only has the QA references from one worksheet and not all worksheets.

I currently have the coding on the job list sheet (the report sheet). Should it be on a different sheet?

I'm thinking I may have to give up soon, until I get some training on this as this is far too advanced for my little knowledge

Thanks for all the help!

 

[Michael M]

Oh, Duh !!!.....
I just noticed it is a Worksheet activate macro !!
You can't do all works sheets from that type of macro.
You will need to change it to a standard module code

Second, it will still delete text from eavey sheet....I thought that was what you wanted...if not please let me know which sheet to clear ?

Third, When the auto filter kicks in, is Row 1 actually a valid row, ie, not blank

Private Sub MM190712()
Dim LR As Long, ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
    ws.Activate
        ws.UsedRange.Offset(1).ClearContents 'clear existing data
        With ActiveSheet
            .AutoFilterMode = False 'remove any prior filtering
            .Rows(1).AutoFilter 'activate autofilter
            .Rows(1).AutoFilter 6, ">=QA" 'filter column F for QA
            LR = .Range("A" & .Rows.Count).End(xlUp).Row 'is any data visible?
                If LR > 1 Then
                    .Range("A2:G" & LR).Copy Range("A2") 'copy any data visible to report
                    Else
                    Range("A2") = "no data found" 'if none, give that message
                End If
        .AutoFilterMode = False 'turn off autofilter
        End With
Next ws
Application.ScreenUpdating = True
End Sub

 

[KathrynMcG]

Thanks! I'm not really sure what any of thats means - still a complete beginner here BUT...

I seem to have solved my own problem I think, but have created a new one in the process.

I have now got it to check multiple worksheets and copy and paste the rows into my new worksheet labelled "QA Jobs" (without blanking out the previous sheets). But I do not know how to get it to only paste after the last used row (which will change every time as jobs are added and removed).

 Private Sub Worksheet_Activate()
Dim LR As Long
 Dim sh1 As Worksheet, sh2 As Worksheet
 
 Set sh1 = Worksheets("Workshop&Utility Rooms")
 Set sh2 = Worksheets("Lab & Offices")
Me.UsedRange.Offset(1).ClearContents                'clear existing data
With sh1
    .AutoFilterMode = False                         'remove any prior filtering
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 6, ">=QA"                  'filter column F for QA
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'is any data visible?
    If LR > 1 Then
        .Range("A2:G" & LR).Copy Range("A2")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
  
End With
With sh2
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 6, ">=QA"                  'filter column F for QA
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'is any data visible?
    If LR > 1 Then
        .Range("A2:G" & LR).Copy Range("A10")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
  
End With

End Sub

This is what I now have. So it sweeps through sh1 and pastes them into my "QA JOBS" sheet from row A2 down, and then sweeps through and checks sh2. For now I have told it to paste the rows copied from sh2 from row A10, as i just wanted them to stop pasting over each other. But as there will be a different number of jobs each time the sheet is opened, it would be better if it would automatically find the last avliable row and then paste the next lot underneath.

Really appreciate all your help with this! I'm finding it all very interesting and will be looking for some training in the future

Kathryn.

 

[Michael M]

Yeah, I understand....if you follow the logic...
You find the last row, copy data to the next row down....the next step would be ........find the last row again, so that it refreshes the LR variable

With sh2
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 6, ">=QA"                  'filter column F for QA
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'is any data visible?
    If LR > 1 Then
        .Range("A2:G" & LR).Copy Range("A10")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
  LR = .Range("A" & .Rows.Count).End(xlUp).Row "find the last row again
End With

If you F8 through the code you will see that LR changes from the 1st one to the 2nd one !!

 

[Michael M]

slight change !

  Private Sub Worksheet_Activate()
Dim LR As Long, LR2 As Long
 Dim sh1 As Worksheet, sh2 As Worksheet
 
 Set sh1 = Worksheets("Workshop&Utility Rooms")
 Set sh2 = Worksheets("Lab & Offices")
Me.UsedRange.Offset(1).ClearContents                'clear existing data
LR = sh1.Cells(Rows.Count, "A").End(xlUp).Row
LR2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
With sh1
    .AutoFilterMode = False                         'remove any prior filtering
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 6, ">=QA"                  'filter column F for QA
    If LR > 1 Then
        .Range("A2:G" & LR).Copy Range("A2")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
  
End With
With sh2
    .Rows(1).AutoFilter                             'activate autofilter
    .Rows(1).AutoFilter 6, ">=QA"                  'filter column F for QA
    If LR2 > 1 Then
        .Range("A2:G" & LR).Copy Range("A10")        'copy any data visible to report
    Else
        Range("A2") = "no data found"               'if none, give that message
    End If
    .AutoFilterMode = False                         'turn off autofilter
  
End With

End Sub

 

[KathrynMcG]

Nope, still not working.

Doesn't the "A2" have to change in this first bit:

 If LR > 1 Then
        .Range("A2:G" & LR).Copy Range("A2")        'copy any data visible to report

And then the "A10" that i put into the second bit?

If LR2 > 1 Then
        .Range("A2:G" & LR).Copy Range("A10")        'copy any data visible to report

Cause at the moment it seems to be overiding any changes you have made with the LR stuff. It still pastes the first worksheets rows starting at A2 and then the second sheets rows starting at A10 and not at the next available row as wanted.

Thanks again for the help!