Code for finding headers in the worksheet taking time to run

[ThrottleWorks]

Hi,

I am using below code to find headers in the worksheet.
There are more than 10 worksheets in the file that is why am using below Function and Sub to find headers in the worksheet.
In one of the worksheet, there are more than 150 headers to be searched, in this scenario code is taking time to get complete or gets hang.
Can anyone please suggest me how to resolve this.

PS - around 3 minutes to complete 150 headers.

Public Function GetHeaderPos(wks As Worksheet, sHeaderName As String) As Integer
    Dim rFound As Range
    With wks
        Set rFound = .Cells.Find(sHeaderName, .Range("A1"), xlValues, xlWhole, xlByColumns, xlNext)
        If Not rFound Is Nothing Then
            GetHeaderPos = rFound.Column
        Else
            GetHeaderPos = 0
        End If
    End With
End Function

Sub Check_Headers_01()
    Dim My_Column As Long
    Dim MacroBook As Workbook
    Dim Map_Sht As Worksheet
    Dim TempRng As Range
    Dim TRng As Range
    Dim TempLr As Long
   
    Set MacroBook = ThisWorkbook
    Set Map_Sht = MacroBook.Worksheets("Mapping")
   
    'Bk_Template.Activate
    'Sht_TMPLT_01.Select
    TempLr = Map_Sht.Range("E" & Rows.Count).End(xlUp).Row 'Workings_FO Book Not in Mapping
    Set TempRng = Map_Sht.Range("E2:E" & TempLr)
    For Each TRng In TempRng
        My_Column = 0
        My_Column = GetHeaderPos(Sht_TMPLT_01, TRng.Value)
        If My_Column = 0 Then MsgBox "Header '" & TRng & "'" & "  is not found in tab Name '" & Sht_TMPLT_01.Name & "'" & ", please check and try again": Exit Sub
    Next TRng
End Sub

 

[Marc L]

Hi,​

​

you could also use the MATCH worksheet function and sometimes with a single codeline without any loop …​

​

 

[p45cal]

Yes, it looks like .Find is the time consuming part.
Are all the headers on a sheet in the same row? Do you know which row that is?
Application.Match acting on a single row would likely be faster (and even faster if we put that row's data into memory instead of looking to the sheet for every search).
If you don't know what row the headers are, we could start with .Find over the used range of the sheet, and once one header had been found move on to using Match for the rest.

 

[ThrottleWorks]

Hi @Marc L sir, thanks for the help. Have a nice day ahead.

Hi @p45cal sir, thanks for the help. Have a nice day ahead.
All headers are in the first row of worksheet. Trying with Match method.

 

[p45cal]

Public Function GetHeaderPos(wks As Worksheet, sHeaderName As String) As Long
    zz = Application.Match(sHeaderName, wks.Rows(1), 0)
    If Not IsError(zz) Then GetHeaderPos = zz Else GetHeaderPos = 0
End Function

It's so short it might be easier to include such code within the body of macro Check_Headers_01, what's more, you could put row 1 values into memory and match on that - you'd get your results before your finger left the mouse button.

eg.

Sub NewCheck_Headers_01()
Dim My_Column As Long
Dim MacroBook As Workbook
Dim Map_Sht As Worksheet
Dim TempRng As Range
Dim TRng As Range
Dim TempLr As Long, AllHdrs, rw
  
Set MacroBook = ThisWorkbook
Set Map_Sht = MacroBook.Worksheets("Mapping")
  
'Bk_Template.Activate
'Sht_TMPLT_01.Select
TempLr = Map_Sht.Range("E" & Rows.Count).End(xlUp).Row    'Workings_FO Book Not in Mapping
Set TempRng = Map_Sht.Range("E2:E" & TempLr)
AllHdrs = Sht_TMPLT_01.Rows(1).Value 'row 1 into memory.
For Each TRng In TempRng
  My_Column = 0
  rw = Application.Match(TRng.Value, AllHdrs, 0)
  If IsError(rw) Then
    MsgBox "Header '" & TRng & "'" & "  is not found in tab Name '" & Sht_TMPLT_01.Name & "'" & ", please check and try again": Exit Sub
  Else
    My_Column = rw
  End If
Next TRng
End Sub

 

[ThrottleWorks]

Hi @p45cal sir, thanks a lot for the help.
I am checking this code and will revert with details.