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]

Ok, how about

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))
         .Item(Cl.Value) = Cl.Offset(, -1).Value & "|" & .Item(Cl.Value)
      Next Cl
      For Each Ky In .keys
         Splt = Split(Left(.Item(Ky), Len(.Item(Ky)) - 1), "|")
         Sheets(Splt).Select
         Selection.ExportAsFixedFormat Type:=xlTypePDF, _
            filename:="C:\Users\riazd.PLAZA\Desktop\Reporting\Newfolder" & Ky & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      Next Ky
   End With
End Sub

 

[riazd]

Hi Fluff

This is some higher grade code ,


I'm getting a run time error on the Sheets(Splt).Select, is it possible to upload the file so that you can maybe look at it

Thanx for your assistance, i really appreciate the effort

have a wonderful day,

 

[Fluff]

You can't upload files to this site, but you can upload to somewhere like OneDrive, Dropbox or GoogleDrive, mark for sharing & post the link to the thread.

 

[riazd]

Hi Fluff

Attached please find link to the test file,


https://www.dropbox.com/s/1nbs3ca01cq3d94/Test.xlsx?dl=0


Thanx

 

[Fluff]

You have values in col A for which there is no sheet.

 

[Fluff]

This will ignore col A if there is no matching sheet

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))
         If Evaluate("isref('" & Cl.Offset(, -1).Value & "'!A1)") Then
            .Item(Cl.Value) = Cl.Offset(, -1).Value & "|" & .Item(Cl.Value)
         End If
      Next Cl
      For Each Ky In .keys
         Splt = Split(Left(.Item(Ky), Len(.Item(Ky)) - 1), "|")
         Sheets(Splt).Select
         Selection.ExportAsFixedFormat Type:=xlTypePDF, _
            filename:="C:\Users\riazd.PLAZA\Desktop\Reporting\Newfolder" & Ky & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      Next Ky
   End With
End Sub

 

[riazd]

Hi Fluff

It seems to be working, except that it's printing blank pages, any idea why?

Thanx

 

[Fluff]

No idea I'm afraid.
I'll have alook over the weekend, if nobody else steps in.

 

[Fluff]

Got it, it should be

         [COLOR=#ff0000]ActiveSheet[/COLOR].ExportAsFixedFormat Type:=xlTypePDF, _
            filename:="C:\mrexcel\fluff\" & Ky & "Payslips", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

 

[riazd]

Hi Fluff,

Thank you so much for your assistance, the code works brilliantly, would it be possible to explain how this code works, or direct me to some resource that explains how it works,

Have a wonderful day,