If/Else Checking If Header Exist

[mayoung]

I am wanting to check if part of a header exist starting in Row-1 Column-Y and going Through Column-AL. If that part of the header does not exist to create it. If it does exist then do nothing. I can create the header if it does not exist. The part I am missing is the Else if there is a successful match found. Can someone help me fix the error?

Sub testheaders()

Application.ScreenUpdating = False

Dim arrCols, sht As Worksheet, s
Dim LastCol As Long, HeaderRng As Range


'All the fields in the final version in specific order needed
arrCols = Array("Sales Order #", "Order Date", "Days On Order", "Order Class", "Ship Method", "BO Ship Method", "Line Status", "Order Qty", "Allocated QtY", "Invoiced Qty", "BO Qty", "Comment", "Weight (lbs)", "Completed")

Set sht = ActiveSheet

With sht
    ' find last column with data in the first row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    ' set the scanned range with data in the Header row
    Set HeaderRng = .Range(.Cells(1, 25), .Cells(25, LastCol))

    For Each s In arrCols
        If IsError(Application.Match(s, HeaderRng, 0)) Then '<-- no Match
            MsgBox s & " is a missing header"
            
    Range("Y1").FormulaR1C1 = "Sales Order #"
    Range("Z1").FormulaR1C1 = "Order Date"
    Range("AA1").FormulaR1C1 = "Days On Order"
    Range("AB1").FormulaR1C1 = "Order Class"
    Range("AC1").FormulaR1C1 = "Ship Method"
    Range("AD1").FormulaR1C1 = "BO Ship Method"
    Range("AE1").FormulaR1C1 = "Line Status"
    Range("AF1").FormulaR1C1 = "Order Qty"
    Range("AG1").FormulaR1C1 = "Allocated Qty"
    Range("AH1").FormulaR1C1 = "Invoiced Qty"
    Range("AI1").FormulaR1C1 = "BO Qty"
    Range("AJ1").FormulaR1C1 = "Comment"
    Range("AK1").FormulaR1C1 = "Weight (lbs)"
    Range("AL1").FormulaR1C1 = "Completed"
                
        Else '<-- successful match
            MsgBox s & " header found"
            
        End If
    Next s
End With

Application.ScreenUpdating = False

End Sub

 

[dmt32]

Hi,
see if this update to your code does what you want

Option Base 1
Option Explicit
Sub testheaders()
    Dim HeaderRng       As Range
    Dim c               As Long
    Dim missingheader   As String, s As String
    Dim arrCols         As Variant, header As Variant
    Dim sht             As Worksheet
  
   
    'All the fields in the final version in specific order needed
    arrCols = Array("Sales Order #", "Order Date", "Days On Order", "Order Class", "Ship Method", _
                    "BO Ship Method", "Line Status", "Order Qty", "Allocated QtY", "Invoiced Qty", _
                    "BO Qty", "Comment", "Weight (lbs)", "Completed")
  
    Set sht = ActiveSheet

    ' set the scanned range with data in the Header row
    Set HeaderRng = sht.Cells(1, 25).Resize(, UBound(arrCols))
  
    For Each header In arrCols
        c = c + 1
        If IsError(Application.Match(header, HeaderRng, 0)) Then
            HeaderRng.Cells(1, c).Value = arrCols(c)
            missingheader = missingheader & Chr(10) & arrCols(c)
        End If
    Next header
  
    If Len(missingheader) > 0 Then
      
        MsgBox "Following Headers Replaced" & Chr(10) & missingheader, 48, "Missing Headers"
      
    Else
      
        MsgBox header & " All headers found", 64, "All Complete"
      
    End If
End Sub

Dave

 

[mayoung]

Hi,
see if this update to your code does what you want

Option Base 1
Option Explicit
Sub testheaders()
    Dim HeaderRng       As Range
    Dim c               As Long
    Dim missingheader   As String, s As String
    Dim arrCols         As Variant, header As Variant
    Dim sht             As Worksheet
 
  
    'All the fields in the final version in specific order needed
    arrCols = Array("Sales Order #", "Order Date", "Days On Order", "Order Class", "Ship Method", _
                    "BO Ship Method", "Line Status", "Order Qty", "Allocated QtY", "Invoiced Qty", _
                    "BO Qty", "Comment", "Weight (lbs)", "Completed")
 
    Set sht = ActiveSheet

    ' set the scanned range with data in the Header row
    Set HeaderRng = sht.Cells(1, 25).Resize(, UBound(arrCols))
 
    For Each header In arrCols
        c = c + 1
        If IsError(Application.Match(header, HeaderRng, 0)) Then
            HeaderRng.Cells(1, c).Value = arrCols(c)
            missingheader = missingheader & Chr(10) & arrCols(c)
        End If
    Next header
 
    If Len(missingheader) > 0 Then
     
        MsgBox "Following Headers Replaced" & Chr(10) & missingheader, 48, "Missing Headers"
     
    Else
     
        MsgBox header & " All headers found", 64, "All Complete"
     
    End If
End Sub

Dave

Thank You so Much!!

 

[dmt32]

Thank You so Much!!

most welcome - glad solution helps & appreciate your feedback

Dave