Make folder and save file based on different cell values.

[Daroh]

Hi all, I want to create a code that creates a new folder on the desktop if not there already. Within the folder, I want to save a multiple reports, the data for these reports are from a table on a sheet called 'C_Report'. The data is pulled from a Sheet2 using index/match formula to match the data on the report. What is the best way to do this? Any help is very much appreciated.

 

[Daroh]

Public Sub Reports()

Dim myPath As String, wholePath As String, filePath As String, firstName() As String
Dim vStats As Variant
Dim currentDate As Date
Dim LastRow As Long, ArrayIndex1 As Long

Application.ScreenUpdating = False

With Sheet1
    
        currentDate = .Range("H3").Value2
        LastRow = .Range("A1:A35").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        vStats = .Range("A1:E" & LastRow)
        
        myPath = .Range("k3").Value2
        
        LastRow = .Columns(1).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        If LastRow = 1 Then: MsgBox ("No Ppl Selected in database."): Exit Sub
    
        wholePath = myPath & "\" & Replace(currentDate, "/", "-") & " X Reports"
        If Dir(wholePath, vbDirectory) = vbNullString Then MkDir (wholePath)
    

With Sheet2
        For ArrayIndex1 = LBound(vStats) To UBound(vStats)
        .Range("B2").Value2 = "PPL Review - " & Replace(Format(currentDate, "dd/mm/yyyy"), "-", "/")
        .Range("c3").Value2 = vStats(ArrayIndex1, 1)
        .Range("c4").Value2 = vStats(ArrayIndex1, 2)
        .Range("c5").Value2 = vStats(ArrayIndex1, 3)
        .Range("c6").Value2 = vStats(ArrayIndex1, 4)
        .Range("c7").Value2 = vStats(ArrayIndex1, 5)
    
     
        filePath = wholePath & "\" & "CPAP Review - " & vStats(ArrayIndex1, 1) & " " & vStats(ArrayIndex1, 2) '
        firstName = Split(vStats(ArrayIndex1, 1), " ")
     
     'create PDF file
        Sheet2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Next ArrayIndex1
End With

End With
Application.ScreenUpdating = True

End Sub

This is the solution I used for this.