VBA Copy, Paste to Different Workbook, Save as then loop the action through slicer

[krisoey]

Hello,

I have some VBA issues with looping slicer. I'm trying to copy and paste certain data from one workbook to another, save it by certain data (contract#). I'm trying to loop this action through slicer

Below is the current VBA that i frankensteined together from this forum.

Any help is appreciated

Function SlicerFunction() As Single
  Dim wkb As Workbook
  Dim wkb2 As Workbook
  Dim strFileName As String, strFilePath As String
 Dim slItem As SlicerItem
    Dim i As Long
    
   
 
    strFilePath = Workbooks("AccrualtoTest.xlsm").Sheets("Macro").Range("AZ2")
    strFileName = "RPA PS Accrual Template.xlsx"
    strsecondFile = strFilePath & strFileName
    
 
    
    
    On Error Resume Next
    
        Set wkb = Workbooks(strFileName)
    Set wkb2 = Workbooks("AccrualtoTest.xlsm")
   
    
    If wkb Is Nothing Then
        
        Set wkb = Workbooks.Open(strsecondFile)
    
    
    End If
    
    If wkb Is Nothing Then
        MsgBox strsecondFile & "Not Found", vbCritical, "Not Found"
        Exit Function
        
        End If
        
    On Error GoTo 0
    
 

     
    Workbooks("AccrualtoTest.xlsm").Sheets("Macro").Activate
    
    Range("L3").Select
    Selection.Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("AccrualtoTest.xlsm").Activate
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("AccrualtoTest.xlsm").Activate
    Range("C3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("AccrualtoTest.xlsm").Activate
    Range("K3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("AccrualtoTest.xlsm").Activate
 Range("J3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
       Range("E6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("AccrualtoTest.xlsm").Activate
    Range("E3:E53").Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("A17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Windows("AccrualtoTest.xlsm").Activate
    Range("N3:N53").Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("B17").PasteSpecial xlPasteValues
    
    Windows("AccrualtoTest.xlsm").Activate
    Range("O3:O53").Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("C17").PasteSpecial xlPasteValues
    
    Windows("AccrualtoTest.xlsm").Activate
    Range("D3:D53").Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("D17").PasteSpecial xlPasteValues
    Windows("AccrualtoTest.xlsm").Activate
    Range("I3:I53").Copy
    Windows("RPA PS Accrual Template.xlsx").Activate
    Range("E17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("AccrualtoTest.xlsm").Activate
    

   
   
   Set MYPATH = Workbooks("AccrualtoTest.xlsm").Sheets("Macro").Range("AZ2")
   
   Dim part2 As String
   part2 = Workbooks("AccrualtoTest.xlsm").Sheets("Macro").Range("BA3").Value
   

    If Len(Dir(MYPATH & part2, vbDirectory)) = 0 Then
    MkDir MYPATH & part2
    
    
    End If
    
    

    Workbooks("RPA PS Accrual Template.xlsx").Activate
    Sheets("Sheet1").UsedRange.Replace What:="(blank)", Replacement:=""
        Application.DisplayAlerts = False
    wkb.SaveAs Filename:=MYPATH & part2 & "\" & part2 & ".xlsx", FileFormat:=xlWorkbookDefault, CreateBackup:=False
    Application.DisplayAlerts = True
    
   ActiveWorkbook.Close
  
    
      
    
End Function


Sub Step_Thru_SlicerItems2()
    Dim slItem As SlicerItem
    Dim i As Long
    
    Application.ScreenUpdating = False
    With Workbooks("AccrualtoTest.xlsm").Sheets("Macro").SlicerCaches("Slicer_Contract")
        '--deselect all items except the first
        .SlicerItems(1).Selected = True
        For Each slItem In .VisibleSlicerItems
            If slItem.Name <> .SlicerItems(1).Name Then _
                slItem.Selected = False
        Next slItem
        Call MyFunction(1)
        '--step through each item and run custom function
        For i = 2 To .SlicerItems.Count
            .SlicerItems(i).Selected = True
            .SlicerItems(i - 1).Selected = False
            Call MyFunction(i)
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[krisoey]

Found the error...apparently my function is called differently in the sub