Looping through unique values in a list to print worksheets matching the criteria

[riazd]

Hi

I'm trying to, loop through a list on my index sheet which contains the worksheet names and a location, and print to PDF for each unique location. Currently the macro is manually making each unique value equal the location, but i would like to automate it,


The code that i'm using is as follows viz.

Option Explicit


Sub GroupSheets()
Dim ShtGroup() As String
Dim Lr As Long
Dim ShtName As String
Dim n As Long
Dim p As Range
Dim c As Range


Lr = Range("A:B").find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row




For Each p In Sheets("Index").Range("A2:A" & Lr)
If (p.Offset(, 1)) = "VER" Then
ShtName = p.Value
n = n + 1
ReDim Preserve ShtGroup(1 To n)
ShtGroup = ShtName
End If
Next
Sheets(ShtGroup).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\riazd.PLAZA\Desktop\Reporting\Newfolder" & "VER" & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False


For Each p In Sheets("Index").Range("A2:A" & Lr)
If (p.Offset(, 1)) = "FAC" Then
ShtName = p.Value
n = n + 1
ReDim Preserve ShtGroup(1 To n)
ShtGroup = ShtName
End If
Next
Sheets(ShtGroup).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\riazd.PLAZA\Desktop\Reporting\Newfolder" & "FAC" & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False






End Sub

The data on the index sheet is in the following format viz.



[TABLE="width: 150"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Sheet_Name[/TD]
[TD]Location[/TD]
[/TR]
[TR]
[TD]003[/TD]
[TD]Ver[/TD]
[/TR]
[TR]
[TD]004[/TD]
[TD]Ver[/TD]
[/TR]
[TR]
[TD]P004[/TD]
[TD]Ver[/TD]
[/TR]
[TR]
[TD]P005[/TD]
[TD]Ver[/TD]
[/TR]
[TR]
[TD]P243[/TD]
[TD]FAC[/TD]
[/TR]
[TR]
[TD]P244[/TD]
[TD]FAC[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Thanx[/TD]
[TD][/TD]
[/TR]
[TR]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 150"]
<colgroup><col><col></colgroup><tbody></tbody>[/TABLE]

 

[Fluff]

Glad to help & thanks for the feedback.

Hopefully this will help

Sub PrintShts()
   Dim cl As Range
   Dim Ky As Variant, Splt As Variant
   
   With CreateObject("scripting.dictionary")
      For Each cl In Range("B2", Range("B" & Rows.count).End(xlUp))           'Loops through col B
         If Evaluate("isref('" & cl.Offset(, -1).Value & "'!A1)") Then        'checks to see if the sheet exists
            .Item(cl.Value) = cl.Offset(, -1).Value & "|" & .Item(cl.Value)   'Adds col A value to the dictionary item as a concatenated string
         End If
      Next cl
      For Each Ky In .keys                                                    'loops through the dictionary keys
         Splt = Split(Left(.Item(Ky), Len(.Item(Ky)) - 1), "|")               'splits the item into an array
         Sheets(Splt).Select                                                  'select all the sheets in the array
         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            filename:="C:\mrexcel\fluff\" & Ky & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      Next Ky
   End With
End Sub

For more info on dictionaries have a look here https://excelmacromastery.com/vba-dictionary/