Macro to export sheets as PDF and name them.

[taylorsm]

Sheet 1 is a list of filenames. Then I have 150 sheets that are unique and contain a unique # in Column A. This unique ID# is also in the filename on sheet 1. I need to match those and export that sheet with that filename. I have something similar, but due to a system change, my format has become different and the macro no longer works. I'm hoping that the hard part is done and someone might be able to adjust this macro to fit the current format. The ID# will also be in the sheet name. Sheet names will be "Note_123456" or if duplicates exist, which should not happen, it would be 'Note_123456_1"

Option Explicit

Sub ED5ExportNotepadPDFFilename()
Dim wsLIST As Worksheet, ws As Worksheet, fPATH As String, Errors As Boolean
Dim fileLIST As Range, Fname As Range, myArr As Variant

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = ActiveWorkbook.Path
    .Show
    If .SelectedItems.Count > 0 Then
        fPATH = .SelectedItems(1) & "\"
    Else
        MsgBox "No destination selected, aborting..."
        Exit Sub
    End If
End With
Set wsLIST = ActiveWorkbook.ActiveSheet
Set fileLIST = wsLIST.Range("A:A").SpecialCells(xlConstants)
fileLIST.Offset(, 1).ClearContents

For Each Fname In fileLIST
    myArr = Split(Fname.Value, ", ")
    For Each ws In ActiveWorkbook.Worksheets
        If InStr(ws.Range("A1"), myArr(2)) > 0 Then
            If InStr(ws.Range("B1"), myArr(0)) > 0 Then
                If InStr(ws.Range("B1"), myArr(1)) > 0 Then
'If error, check length of folder/file name path
                    ws.ExportAsFixedFormat _
                        Type:=xlTypePDF, _
                        Filename:=fPATH & Fname.Value & ".pdf", _
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                    Fname.Offset(, 1).Value = "exported"
                    Exit For
                End If
            End If
        End If
        If ws.Index = ActiveWorkbook.Sheets.Count Then
            Fname.Offset(, 1).Value = "NOT FOUND"
            Errors = True
        End If
    Next ws
Next Fname



Columns("B:B").EntireColumn.AutoFit
    Columns("B:B").Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A2:B219")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
If Errors Then MsgBox "Not all filenames/sheets were matched. See FILENAMES column B"

Application.ScreenUpdating = True

End Sub