Simplify Code

[dataoli]

I am currently use code like the one below to assign column numbers based on the column header title. Unfortunately there can be 30+ headings which takes some time to write code for, I was wondering if there was a quicker way of doing this or if possible shorten the code i already use?

Any help would be greatly appreciated.

Dim RptTtl As Long, RptInt As Long, RptFor As Long, RptSur As Long, RptGen As Long, RptAd1 As Long, RptAd2 As Long, RptAd3 As Long, RptAd4 As Long


    RptTtl = RptHdrs.Find("Title", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptFor = RptHdrs.Find("Forename", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptSur = RptHdrs.Find("Surname", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd1 = RptHdrs.Find("Address 1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd2 = RptHdrs.Find("Address 2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd3 = RptHdrs.Find("Address 3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd4 = RptHdrs.Find("Address 4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column

 

[dataoli]

Bump

 

[My Aswer Is This]

I'm curious.
What is your ultimate goal?
This here I assume is only one little part of some ultimate goal you have.

 

[My Aswer Is This]

Is this the Title Header for a Table?
You said:

based on the column header title. ​

 

[dataoli]

Hi My Aswer Is This

We currently download reports from various websites that need to be import into our database, unfortunately these reports are not compatible in their original format! Depending on the website, we import the website data into a workbook then create a new worksheet with all the headings (over 300) compatible with our system, then copy and format the website data into the new worksheet, delete any empty columns and import the new compatible report into our system.
I was wondering if there was a quicker way of doing this as the code currently in use is very repetitive and it can take some time to code a new reporting system?

Here is the code currently used once the original report is imported into the workbook.

Dim LstHdrRow As Long, LstSrcRow As LongDim LstHdrCol As Long, LstSrcCol As Long, LstRptCol As Long
Dim HdgCol As Long
Dim SrcSht As Worksheet, RptSht As Worksheet
Dim HdgHdrs As Range, SrcHdrs As Range, RptHdrs As Range
    
    Set SrcSht = Sheets("Source")
    Set RptSht = Sheets("Report")

    HdgCol = 1 'Column containing headers on the Headings sheet

    LstHdrRow = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Row
    
    LstSrcRow = Sheets("Source").Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row

    LstHdrCol = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Offset(-1, 0).Row
    LstRptCol = Sheets("Headings").Cells(Rows.Count, HdgCol).End(xlUp).Offset(-1, 0).Row
    
    LstSrcCol = Sheets("Source").Cells.Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column

    Set HdgHdrs = Sheets("Headings").Range(Sheets("Headings").Cells(2, HdgCol), Sheets("Headings").Cells(LstHdrRow, HdgCol))
    Set SrcHdrs = Sheets("Source").Range(Sheets("Source").Cells(1, 1), Sheets("Source").Cells(1, LstSrcCol))

    RptSht.Range(RptSht.Cells(1, 1), RptSht.Cells(1, LstHdrCol)) = WorksheetFunction.Transpose(HdgHdrs)

'Set Report Headers    
Dim RptRef As Long, RptTtl As Long, RptInt As Long, RptFor As Long, RptSur As Long, RptGen As Long
Dim RptAd1 As Long, RptAd2 As Long, RptAd3 As Long, RptAd4 As Long, RptTwn As Long, RptCot As Long
Dim RptPst As Long, RptTel As Long, RptMob As Long, RptEml As Long, RptUrl As Long
Dim RptRsn As Long, RptFun As Long, RptLed As Long, RptEvt As Long, RptSft As Long
Dim RptQ1 As Long, RptQ2 As Long, RptQ3 As Long, RptQ4  As Long, RptQ5 As Long

    RptRef = RptHdrs.Find("URN", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptTtl = RptHdrs.Find("Title", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptFor = RptHdrs.Find("Forename", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptSur = RptHdrs.Find("Surname", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd1 = RptHdrs.Find("Address 1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd2 = RptHdrs.Find("Address 2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd3 = RptHdrs.Find("Address 3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptAd4 = RptHdrs.Find("Address 4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptTwn = RptHdrs.Find("Town", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptCot = RptHdrs.Find("County", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptPst = RptHdrs.Find("Postcode", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptTel = RptHdrs.Find("Phone", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptMob = RptHdrs.Find("Mobile", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptEml = RptHdrs.Find("E-mail", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptUrl = RptHdrs.Find("Website", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptRsn = RptHdrs.Find("Financial Reason", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptFun = RptHdrs.Find("Financial Fund", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptLed = RptHdrs.Find("Financial Ledger", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptEvt = RptHdrs.Find("Event Number", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptSft = RptHdrs.Find("Credit", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptQ1 = RptHdrs.Find("Query1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptQ2 = RptHdrs.Find("Query2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptQ3 = RptHdrs.Find("Query3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptQ4 = RptHdrs.Find("Query4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    RptQ5 = RptHdrs.Find("Query5", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    
'Set Source Headers
Dim SrcPge As Long, SrcDat As Long, SrcDsc As Long, SrcNme As Long, SrcTtl As Long, SrcFor As Long
Dim SrcSur As Long, SrcDob As Long, SrcAd1 As Long, SrcAd2 As Long, SrcTwn As Long
Dim SrcCot As Long, SrcPst As Long, SrcEml As Long, SrcUrl As Long, SrcTel As Long
Dim SrcRef As Long, SrcFun As Long, SrcLed As Long, SrcEvt As Long, SrcSft As Long
    
    SrcPge = SrcHdrs.Find("Page ID", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcDat = SrcHdrs.Find("Created Date", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcDsc = SrcHdrs.Find("Description", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcNme = SrcHdrs.Find("Page Name", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcTtl = SrcHdrs.Find("Title", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcFor = SrcHdrs.Find("Forename", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcSur = SrcHdrs.Find("Surname", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcDob = SrcHdrs.Find("Date of Birth", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcAd1 = SrcHdrs.Find("Address Line 1", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcAd2 = SrcHdrs.Find("Address Line 2", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcTwn = SrcHdrs.Find("Address Line 3", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcCot = SrcHdrs.Find("Address Line 4", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcPst = SrcHdrs.Find("Postcode", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcEml = SrcHdrs.Find("Email Address", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcUrl = SrcHdrs.Find("URL", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcTel = SrcHdrs.Find("Telephone Number", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcRef = SrcHdrs.Find("Custom ID", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcFun = SrcHdrs.Find("Fund", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcLed = SrcHdrs.Find("Ledger", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcEvt = SrcHdrs.Find("Event", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column
    SrcSft = SrcHdrs.Find("Credit", MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues).Column

    
     '------------------
     'misc formatting code e.g.
     '
     '
     'Dim TwnRow As Long
     'For TwnRow = 2 To LstSrcRow
     '   RptSht.Cells(TwnRow, RptTwn) = UCase(SrcSht.Cells(TwnRow, SrcTwn).Value)
     'Next TwnRow
     'Dim CotRow As Long
     'For CotRow = 2 To LstSrcRow
     '    RptSht.Cells(CotRow, RptCot) = Application.Proper(SrcSht.Cells(CotRow, SrcCot).Value)
     'Next CotRow
     '
     '
     '------------------
    
    
Dim ColNum As Long
    For ColNum = LstRptCol To 1 Step -1
        If WorksheetFunction.CountA(RptSht.Range(RptSht.Cells(2, ColNum), RptSht.Cells(LstSrcRow, ColNum))) = 0 Then
            RptSht.Columns(ColNum).Delete
        End If
    Next

Sheets("Report").Move