Sub ProdCodeLookup2()
'Reformats the Product Report (ProdReport), creates the ProdCombo for all items, _
and then uses VLookup to find matches
Application.ScreenUpdating = False

Dim rngX As Range, rngY As Range, rngZ As Range
Dim ICC As String
Dim ItemNum As Variant
Dim Prod1 As String, Prod2 As String, Prod3 As String, Prod4 As String, Prod5 As String
Dim ProdCombo As Variant
Dim FinalRow As Long, StartTime As Long
Dim SecondsElapsed As Double
Dim PRwb As Workbook, BLwb As Workbook
Dim PRsht As Worksheet, BLsht As Worksheet
Dim LVal As Range, VLtable As Range
Dim VLOutput As Variant
Dim Count As Integer
Dim ProdMatchTotal As Variant

Set PRwb = Application.Workbooks("ProductReport")
Set BLwb = Application.Workbooks("Baseline")
Set PRsht = PRwb.Worksheets("Export Worksheet")
Set BLsht = BLwb.Worksheets("Static Table")

StartTime = Timer
'Abbreviate two important header names:
ICC = "Item Catalog Category"
PC = "ProdCombo"

PRsht.Activate
'Hide all columns except those that comprise the ProdCombo, _
format the headers, and add the headers for ProdCombo and ProdCode:
    Columns("C:D").EntireColumn.Hidden = True
    Columns("G:N").EntireColumn.Hidden = True
    Columns("Q:AK").EntireColumn.Hidden = True
    Columns("AM").EntireColumn.Hidden = True
    Columns("AO:AU").EntireColumn.Hidden = True
    Columns("AW:BM").EntireColumn.Hidden = True
    Range("BN1").Value = "ProdCombo"
    Range("BO1").Value = "ProdCode"
    Range("1:1").Select
        Selection.Font.Bold = True

'Filter by Label:
    ActiveSheet.Range("1:1").AutoFilter
'Find the correct header to filter by:
    Set rngX = ActiveSheet.Range("1:1").Find(ICC, LookAt:=xlWhole)
        If Not rngX Is Nothing Then
        End If

'Filter Item Catalog Category by "Labels":
    ActiveSheet.Range(rngX.Address, Selection.End(xlDown)).AutoFilter Field:=rngX.Column, Criteria1:="Label"
'Create the ProdCombo:
    FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
        For Count = 0 To FinalRow - 2
'List the first cell here in the primary key column and ensure that there are no blanks:
            ItemNum = Range("B2").Offset(Count, 0).Value
'Now define the products to ensure they're aligned with the first Item Number:
            Prod1 = Cells(Count + 2, 48).Value
            Prod2 = Cells(Count + 2, 40).Value
            Prod3 = Cells(Count + 2, 15).Value
            Prod4 = Cells(Count + 2, 16).Value
            Prod5 = Cells(Count + 2, 38).Value
'Now concatenate them in the correct order with spaces:
            ProdCombo = Prod1 & " " & Prod2 & " " & Prod3 & " " & Prod4 & " " _
            & Prod5
'Now specify where you want the ProdCombo to appear:
            Range("BN2").Offset(Count, 0) = ProdCombo
        Next Count
'Delete blanks from ProdCombo:
    Set rngY = ActiveSheet.Range("1:1").Find(PC, LookAt:=xlWhole)
        If Not rngY Is Nothing Then
        End If
    ActiveSheet.Range(rngY.Address, Selection.End(xlDown)).AutoFilter Field:=rngY.Column, Criteria1:="="
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Delete
    ActiveSheet.ShowAllData
    ActiveSheet.Range(rngX.Address, Selection.End(xlDown)).AutoFilter Field:=rngX.Column, Criteria1:="Label"

'Now run the ProdCodeLookup2 sub procedure
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Set VLtable = BLsht.Range("$AY$1:$BA$29741")
On Error Resume Next
For Count = 0 To FinalRow
    
    Set LVal = SRsht.Range("BN2").Offset(Count, 0)

 VLOutput = Application.VLookup(LVal, VLtable, 3, False)
    
 If IsError(VLOutput) Then
        VLOutput = 0
    Else
        PRsht.Range("BO2").Offset(Count, 0) = VLOutput
    End If
Next Count
On Error GoTo 0

Set rngZ = ActiveSheet.Range("1:1").Find("ProdCode", LookAt:=xlPart)
        If Not rngZ Is Nothing Then
        End If
ActiveSheet.Range(rngZ.Address, Selection.End(xlDown)).AutoFilter Field:=rngZ.Column, Criteria1:="<>"
ProdMatchTotal = Application.Count(Range(rngZ.Offset(1), rngZ.Offset(FinalRow)))
MsgBox ("There are " & ProdMatchTotal & " baseline product matches")

Application.ScreenUpdating = True

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub