Set slicer from data branch and print PDF - vba

Question

I have data from pivot-filter I world like to set data branch for select filter
something like this
001 Great Northern << select
002 Great Eastern << select
003 Great Southen << not select
004 Great Midland << Not select
015 Great Mainline Transport << Select
025 Great Asia Industy << not select
030 Great Deutscher << Select
Select with single select after print PDF unselect and select next to finish how to do this code thank you sir (sorry for bad english. I'm not good conversation english)
Sub Button99_PDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim codebranch As String
Dim branchname As String
Dim lictype As String
On Error GoTo errHandler
Dim tblRaw As ListObject, tblFiltered As ListObject
Dim sh_raw As Worksheet, sh_filtered As Worksheet
Dim critRange As Range, copyToRng As Range, resizeRng As Range
Dim startRow As Long, lastRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Sheets("Pivot_Filters").Range("a8").Value = "" Then Exit Sub
Set wsPF = ThisWorkbook.Sheets("Pivot_Filters")
Set wsSD = ThisWorkbook.Sheets("SalesData")
Set wsOP = ThisWorkbook.Sheets("Output")
Set tblFiltered = wsOP.ListObjects("table2")
Set ws = ThisWorkbook.Sheets("Output")
Select Case tblFiltered.ListRows.Count
Case Is > 0
tblFiltered.DataBodyRange.Delete
tblFiltered.ListRows.Add
Case Else
tblFiltered.ListRows.Add
End Select
For Each slcCache In ActiveWorkbook.SlicerCaches
slcCache.ClearManualFilter
Next
With ActiveWorkbook.SlicerCaches("Slicer_รหัส_สาขา")
For Each oSlicerItem In .SlicerItems
If oSlicerItem.Name = "001 : วิภาวดี" Then
oSlicerItem.Selected = True
Else
oSlicerItem.Selected = False
End If
With ActiveWorkbook.SlicerCaches("Slicer_ประเภท_ใบอนุญาต")
.SlicerItems("ตัวแทน").Selected = True
.SlicerItems("Micro Insurance").Selected = True
.SlicerItems("นายหน้าบุคคล").Selected = False
.SlicerItems("นายหน้านิติบุคคล").Selected = False
.SlicerItems("พรบ.").Selected = True
.SlicerItems("นายหน้า").Selected = False
.SlicerItems("โบรคเกอร์").Selected = False
.SlicerItems("ไม่มีบัตร").Selected = False
.SlicerItems("FALSE").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_ชื่อหลักสูตร")
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 1").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 2").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 3").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 4").Selected = True
.SlicerItems("ขอรับใบอนุญาตนายหน้าประกันวินาศภัย").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 1").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 2").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 3").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 4").Selected = True
.SlicerItems("ขอรับใบอนุญาตตัวแทนประกันวินาศภัย").Selected = True
.SlicerItems("ไม่มีข้อมูล").Selected = False
End With
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight21"
wsSD.Range("Sales_Data[#All]").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsPF.Range("CritSlicers"), _
CopyToRange:=wsOP.Range("ExtractSlicers"), _
Unique:=False
'Find Filtered table Header row
startRow = tblFiltered.HeaderRowRange.Row
'Find last row on Filtered tab (deduct 1 since Advanced filter retrieves the headers)
lastRow = wsOP.Columns(2).Find("*", , , , xlByRows, xlPrevious).Row
'If the last raw is greater than the Header row, resize the Filtered table and delete the retrieved Headers (which will be in the first row of the Filtered table)
If lastRow > startRow Then
Set resizeRng = Range("table2[#All]").Resize(tblFiltered.Range.Rows.Count + (lastRow - startRow - 1), tblFiltered.Range.Columns.Count)
tblFiltered.Resize resizeRng
' tblFiltered.ListRows(2).Delete
Else
'If the last row is equal to Header row it means only the Column headers have been fetched, so there is no matching row to the filter criterias
'The if condition is only for let's say second line of defence
If tblFiltered.HeaderRowRange(11, 2) = tblFiltered.DataBodyRange(11, 2) Then
tblFiltered.DataBodyRange.Delete
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Add2 _
Key:=Range("Table2[ครั้งที่]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Add2 _
Key:=Range("Table2[วัน" & Chr(10) & "หมดอายุ]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("Output").Columns("A:M").AutoFit
Worksheets("Output").Columns("K").Hidden = True
Worksheets("Output").PageSetup.PrintArea = "PrintFocus"
stword3 = GetSelectedSlicerItems("Slicer_รหัส_สาขา")
stword = "รายงานต่อใบอนุญาต"
stword4 = "ประกันวินาศภัย"
stword5 = GetSelectedSlicerItems2("Slicer_ประเภท_ใบอนุญาต")
Range("A9") = stword & " " & stword3 & " " & stword5 & " " & stword4
If InStr(Range("a9").Value, "นายหน้า") > 0 Then
lictype = "นายหน้า"
ElseIf InStr(Range("a9").Value, "ตัวแทน") > 0 Then
lictype = "ตัวแทน"
ElseIf InStr(Range("a9").Value, "ใบอนุญาตทั้งหมด") > 0 Then
lictype = "ร่วมใบอนุญาต"
End If
codebranch = GetSelectedSlicerItems3("Slicer_รหัส_สาขา")
branchname = GetSelectedSlicerItems("Slicer_รหัส_สาขา")
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd_mm_yy")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next oSlicerItem
End With
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

Answer 1

I'm looking for code Set branch into the VBA Slicer. Then make ordering print loop by set branch field VBA.
001 Great Northern << select
002 Great Eastern << select
003 Great Southen << not select
004 Great Midland << Not select
015 Great Mainline Transport << Select
025 Great Asia Industy << not select
030 Great Deutscher << Select
This code from searching internet. I try hard for searching this but its look right only count slicer from first data to last data.
For Each slcCache In ActiveWorkbook.SlicerCaches
slcCache.ClearManualFilter
Next
With ActiveWorkbook.SlicerCaches("Slicer_รหัส_สาขา")
For Each oSlicerItem In .SlicerItems
If oSlicerItem.Name = "001 : วิภาวดี" Then
oSlicerItem.Selected = True
Else
oSlicerItem.Selected = False
End If