Searching for Collection Item as string?

Question

I'm trying to create a macro which scans a generate remittance spreadsheed and extracts the remittances for specific suppliers. I have created a collection to store the suppliers name and ID, and would like it to loop through the list and extract the data to a new worksheet and save it.

I have tried to declare the subID as a string and search for it using the Cells.Find method, in the hope that I can add/amend suppliers quickly, rather than create a full subroutine for each one.

I am still relatively new to VBA, so apologies for any terrible coding practices in the below.

My code so far is:

    Dim Suppliers As Collection
Set Suppliers = New Collection
Dim supID As Integer
Dim sMonth_Name As String
Dim sDate As String

Suppliers.Add "4051", "EON Energy"
Suppliers.Add "7037", "Opus"
Suppliers.Add "15016", "Crown Gas and Power"
Suppliers.Add "23090", "BGB"
Suppliers.Add "23965", "SSE"
Suppliers.Add "1744", "NPower"
Suppliers.Add "60599", "WAVE"
Suppliers.Add "73592", "Water Plus"
Suppliers.Add "15895", "Business Stream"
Suppliers.Add "54493", "Castle Water"


'Delete all blank rows
Application.ScreenUpdating = False
Set UsedRng = ActiveSheet.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    Application.ScreenUpdating = False
 
For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(Rows(RowIndex)) = 0 Then
            Rows(RowIndex).Delete
        End If
Next RowIndex
 
    sMonth_Name = Format((Date), "mm" & "-" & "mmm")
    sDate = Format((Date), "dd" & "." & "mm" & "." & "yy")
  
'SAVE DIRECTORY
    savePath1 = "[redacted]\Personal\Desktop\EXCEL REMITS TEST" & "\" & sMonth_Name
    savePath2 = savePath1 & "\" & sDate
    savePath3 = savePath2 & "\"
    
    MkDir (savePath1)
    MkDir (savePath2)

Columns("J:J").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
       Columns("D:D").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
    
    
For supID = 1 To Suppliers.Count
    On Error Resume Next
    
    With Application.FindFormat.Font
        .FontStyle = "Bold"
        .Subscript = False
        .TintAndShade = 0
    End With
    Cells.Find(What:=Suppliers.Item(supID), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True).Activate
    ActiveCell.EntireRow.Select
    ActiveCell.EntireRow.Insert
    Cells(ActiveWindow.RangeSelection.Row, 1).Select
     Cells.Find(What:=Suppliers.Item(supID), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True).Activate
    Cells.Find(What:="N", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=True).Activate
    ActiveCell.EntireRow.Select
    ActiveCell.EntireRow.Insert
    Cells(ActiveWindow.RangeSelection.Row, 1).Select
    Range("A1").Select
    Cells.Find(What:=Suppliers.Item(supID), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=True).Activate
    ActiveCell.CurrentRegion.Select
    Selection.Cut
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveSheet.Name = "EON"
    Range("A1:M7").Select
    Selection.Font.Bold = True
    Range("A1").Select
    
    Next supID