Optimizing Macro that Generates File Based off different Source Tabs

Question

This is the "largest" VBA project I've worked on, but perhaps not the most complicated. The meat and potatoes of it basically copies and pastes data from 2 source tabs into 1. A large piece of the code was broken out and refactored into sub procedures. Variables such as "DEM_Name" are dummy names. The main sub is called GenerateLFF. I welcome any feedback where possible but I'm looking for the following:

• Performance: The performance was greatly improved by using the performance_Opt sub procedure. Even though I haven't tested it with a large data set, it takes 5-6 seconds to work with 5 records.
• Improving the copy_paste sub procedure. This is the sub referenced the most, and I'm wondering if there is any other way of writing it to improve performance.
• Sub procedures: Initially, I would never break out VBA into sub procedures. Now, I might be over doing it. Does breaking out code into may subs hurt performance?

Public Const DEM_WS As String = "DEM_NAME"
Public Const PTI_WS As String = "PTI_NAME"
Public Const LFF_WS As String = "LFF_NAME"
Public DEM_ERow As Integer

Sub GenerateLFF()

    'last row of DEM
    DEM_ERow = Sheets(DEM_WS).Range("C4", Sheets(DEM_WS).Range("C4").End(xlDown)).Rows.Count + 3

        performance_Opt True

            Call format_data_tabs
            Call copy_data
            Call COPY_CONST
            Call CO_BUYER_CONST
            Call Edge_Cases
            Call Formatting
            Call Clear_Contents

        performance_Opt False

End Sub

Sub performance_Opt(TurnOn As Boolean)
    With Application
        .Calculation = IIf(TurnOn, xlCalculationManual, xlCalculationAutomatic)
        .ScreenUpdating = Not TurnOn
        .DisplayStatusBar = Not TurnOn
        .EnableEvents = Not TurnOn

    End With

    ActiveSheet.DisplayPageBreaks = Not TurnOn

End Sub

Private Function Header_Verification() As Boolean

    'Set Wrong as string to contain all wrong columns
    Dim Wrong As String

    'This is a check to ensure the column headers where we are copying data from are what we mapped them to be
    Wrong = ""

    Set wsDEM = Sheets("DEM_NAME")
    Set wsPTI = Sheets("PTI_NAME")

    '*** header verification
    If wsDEM.Range("E3") <> "CSC Account Number" Then Wrong = Wrong & "CSC Account Number: DEM E" & vbCrLf
    If wsDEM.Range("F3") <> "Last Name" Then Wrong = Wrong & "Last Name: DEM F" & vbCrLf
    If wsDEM.Range("G3") <> "First Name" Then Wrong = Wrong & "First Name: DEM G" & vbCrLf
    If wsDEM.Range("H3") <> "Loan Date" Then Wrong = Wrong & "Loan Date" & vbCrLf
    If wsDEM.Range("K3") <> "APR" Then Wrong = Wrong & "APR: DEM K" & vbCrLf
    If wsDEM.Range("M3") <> "Amt Financed" Then Wrong = Wrong & "Amt Financed: DEM M" & vbCrLf
    If wsDEM.Range("Q3") <> "Number of Payments" Then Wrong = Wrong & "Number of Payments: DEM Q" & vbCrLf
    If wsDEM.Range("R3") <> "Freq" Then Wrong = Wrong & "Freq: DEM R" & vbCrLf

    If wsDEM.Range("AL3") <> "Vehicle Year" Then Wrong = Wrong & "Vehicle Year: DEM AL" & vbCrLf
    If wsDEM.Range("AM3") <> "Make" Then Wrong = Wrong & "Make: DEM AM" & vbCrLf
    If wsDEM.Range("AN3") <> "Model" Then Wrong = Wrong & "Model: DEM AN" & vbCrLf

    If wsDEM.Range("AO3") <> "Vin" Then Wrong = Wrong & "Vin: DEM AO" & vbCrLf
    If wsDEM.Range("BE3") <> "Co- buyer First Name" Then Wrong = Wrong & "Co- buyer First Name: DEM BC" & vbCrLf
    If wsDEM.Range("BF3") <> "Co Buyer Last Name" Then Wrong = Wrong & "Co Buyer Last Name: DEM BD" & vbCrLf
    If wsDEM.Range("BG3") <> "CoBuyer Address" Then Wrong = Wrong & "CoBuyer Address: DEM BE" & vbCrLf
    If wsDEM.Range("BH3") <> "Co Buyer City" Then Wrong = Wrong & "Co Buyer City" & vbCrLf
    If wsDEM.Range("BI3") <> "Co Buyer State" Then Wrong = Wrong & "Co Buyer State: DEM BG" & vbCrLf
    If wsDEM.Range("BJ3") <> "Co Buyer Zip" Then Wrong = Wrong & "Co Buyer Zip: DEM BH" & vbCrLf
    If wsDEM.Range("BK3") <> "Co Buyer Social" Then Wrong = Wrong & "Co Buyer Social: DEM BI" & vbCrLf
    If wsDEM.Range("BL3") <> "Co Buyer DOB" Then Wrong = Wrong & "Co Buyer DOB: DEM BJ" & vbCrLf
    If wsDEM.Range("BM3") <> "Schedule 1 PMT Freq" Then Wrong = Wrong & "Schedule 1 PMT Freq: DEM BM" & vbCrLf
    If wsDEM.Range("BN3") <> "Schedule 1 Number of PMT's" Then Wrong = Wrong & "Schedule 1 Number of PMT's: DEM BN" & vbCrLf
    If wsDEM.Range("BO3") <> "Schedule 1 PMT Amount" Then Wrong = Wrong & "Schedule 1 PMT Amount: DEM BO" & vbCrLf
    If wsDEM.Range("BP3") <> "Schedule 1 PMT Start Date" Then Wrong = Wrong & "Schedule 1 PMT Start date: DEM BP" & vbCrLf
    If wsDEM.Range("BQ3") <> "Schedule 2 PMT Freq" Then Wrong = Wrong & "Schedule 2 PMT Freq: DEM BQ" & vbCrLf
    If wsDEM.Range("BR3") <> "Schedule 2 Number of PMT's" Then Wrong = Wrong & "Schedule 2 Number of PMT's: DEM BR" & vbCrLf
    If wsDEM.Range("BS3") <> "Schedule 2 PMT Amount" Then Wrong = Wrong & "Schedule 2 PMT Amount: DEM BS" & vbCrLf
    If wsDEM.Range("BT3") <> "Schedule 2 PMT Start Date" Then Wrong = Wrong & "Schedule 2 PMT Start date: DEM BT" & vbCrLf
    If wsDEM.Range("BV3") <> "Schedule 3 PMT Start Date" Then Wrong = Wrong & "Schedule 3 PMT Start date: DEM BV" & vbCrLf

    '*** header verification ***
    If wsPTI.Range("BQ1") <> "Cus Address" Then Wrong = Wrong & "Cus Address: PTI BQ" & vbCrLf
    If wsPTI.Range("BR1") <> "City" Then Wrong = Wrong & "City: PTI BR" & vbCrLf
    If wsPTI.Range("BS1") <> "State" Then Wrong = Wrong & "State: PTI BS" & vbCrLf
    If wsPTI.Range("BT1") <> "Zip Code" Then Wrong = Wrong & "Zip Code: PTI BT" & vbCrLf
    If wsPTI.Range("BU1") <> "Phone (Home)" Then Wrong = Wrong & "Phone (Home): PTI BU" & vbCrLf
    If wsPTI.Range("BV1") <> "Phone (Cell)" Then Wrong = Wrong & "Phone (Cell): PTI BV" & vbCrLf

    If wsPTI.Range("CD1") <> "Employer Phone" Then Wrong = Wrong & "Employer Phone: PTI CD" & vbCrLf
    If wsPTI.Range("CF1") <> "Social Security #" Then Wrong = Wrong & "Social Security #: PTI CF" & vbCrLf
    If wsPTI.Range("CG1") <> "Date of Birth" Then Wrong = Wrong & "Date of Birth: PTI CG" & vbCrLf

        If Wrong <> "" Then
            MsgBox "Please check the following columns:" & vbCrLf & Wrong
            Header_Verification = False
        Else
            Header_Verification = True
        End If

End Function

Private Sub Filter_Blank(ByVal sheetName As String, ByVal filter_Range As String, ByVal FilterIndex As Integer)

'*** Make sure that the column contains only blanks and loan records, nothing else

    Sheets(sheetName).Select
    Sheets(sheetName).Range(filter_Range, Range(filter_Range).End(xlToRight)).Select
    Selection.AutoFilter Field:=FilterIndex, Criteria1:="<>"

End Sub

Private Sub format_data_tabs()

    If Sheets(PTI_WS).Visible <> xlSheetVisible Then Sheets(PTI_WS).Visible = xlSheetVisible

    'Insert Loan Feed File tab
    Sheets.Add
    ActiveSheet.Name = LFF_WS

    Call Filter_Blank(DEM_WS, "A3", 13)
    Call sort_Asc(DEM_WS, "D3")

    Call Filter_Blank(PTI_WS, "B1", 10)
    Call sort_Asc(PTI_WS, "B1")

    If Header_Verification = False Then End

    Call match_hide_records(DEM_NAME, "B2", PTI_NAME, "D4")

End Sub


Private Sub sort_Asc(ByVal sheetName As String, ByVal filter_Range As String)

    Dim target_range As Range
        Set target_range = Range(filter_Range, Range(filter_Range).End(xlDown))

    Sheets(sheetName).Select

    With Sheets(sheetName).AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add Key:=target_range, Order:=xlAscending
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Private Sub match_hide_records(ByVal broad_list_wbName As String, ByVal broad_list_cell As String, ByVal narrow_list_wbName As String, ByVal narrow_list_cell As String)

Dim broadList As Range
Dim narrowList As Range

Dim broad_wbName As Worksheet
Dim narrow_wbName As Worksheet

    Set broad_wbName = Sheets(broad_list_wbName)
    Set narrow_wbName = Sheets(narrow_list_wbName)

    broad_wbName.Activate
    Set broadList = broad_wbName.Range(broad_list_cell, Range(broad_list_cell).End(xlDown))

    narrow_wbName.Activate
    Set narrowList = narrow_wbName.Range(narrow_list_cell, Range(narrow_list_cell).End(xlDown))

    'match and hide
    For Each cell In broadList

        cell_match = Application.Match(cell.Value, narrowList, 0)

            If IsNumeric(cell_match) = False Then
                cell.EntireRow.Hidden = True
            End If

    Next cell

End Sub

Private Sub copy_data()

    Call copy_paste(DEM_WS, "E4", "A2")
    Call copy_paste(DEM_WS, "F4", "B2")
    Call copy_paste(DEM_WS, "G4", "C2")
    Call copy_paste(PTI_WS, "BQ2", "F2")
    Call copy_paste(PTI_WS, "BR2", "G2")
    Call copy_paste(PTI_WS, "BS2", "H2")
    Call copy_paste(PTI_WS, "BT2", "I2")
    Call copy_paste(PTI_WS, "CG2", "P2")
    Call copy_paste(PTI_WS, "CG2", "BN2")
    Call copy_paste(DEM_WS, "BL4", "V2")
    Call copy_paste(DEM_WS, "BJ4", "AC2")
    Call copy_paste(DEM_WS, "BH4", "AE2")
    Call copy_paste(DEM_WS, "BE4", "AH2")
    Call copy_paste(DEM_WS, "BF4", "AK2")
    Call copy_paste(DEM_WS, "BI4", "AN2")
    Call copy_paste(DEM_WS, "J4", "FK2")
    Call copy_paste(DEM_WS, "AO4", "FN2")
    Call copy_paste(DEM_WS, "BP4", "EX2")
    Call copy_paste(DEM_WS, "BT4", "EY2")
    Call copy_paste(DEM_WS, "BV4", "EZ2")
    Call copy_paste(DEM_WS, "BO4", "DZ2")
    Call copy_paste(DEM_WS, "BS4", "EA2")
    Call copy_paste(DEM_WS, "BU4", "EB2")
    Call copy_paste(DEM_WS, "BN4", "EH2")
    Call copy_paste(DEM_WS, "BR4", "EI2")
    Call copy_paste(DEM_WS, "AN4", "DB2")
    Call copy_paste(DEM_WS, "H4", "AW2")
    Call copy_paste(DEM_WS, "H4", "DN2")
    Call copy_paste(DEM_WS, "M4", "DY2")
    Call copy_paste(PTI_WS, "CD2", "Q2")
    Call copy_paste(PTI_WS, "BW2", "S2")
    Call copy_paste(PTI_WS, "BU2", "BB2")
    Call copy_paste(DEM_WS, "K4", "BK2")
    Call copy_paste(DEM_WS, "AM4", "CY2")
    Call copy_paste(DEM_WS, "AL4", "DC2")
    Call copy_paste(DEM_WS, "T4", "BE2")
    Call copy_paste(DEM_WS, "R4", "DO2")
    Call copy_paste(LFF_WS, "BK2", "FF2")
    Call copy_paste(LFF_WS, "DV2", "EP2")
    Call copy_paste(LFF_WS, "DV2", "EQ2")
    Call copy_paste(DEM_WS, "R4", "CL2")
    Call copy_paste(DEM_WS, "T4", "FI2")
    Call copy_paste(DEM_WS, "Q4", "FJ2")
    Call copy_paste(DEM_WS, "L4", "FS2")
    Call copy_paste(DEM_WS, "R4", "DV2")

End Sub

Private Sub copy_paste(ByVal src_sheetname As String, ByVal src_cell As String, ByVal dst_cell As String)

    Dim dst_sheetName As Worksheet
        Set dst_sheetName = Sheets("Loan Feed File Output")

    Dim src_column As String

    src_column = Left(src_cell, Len(src_cell) - 1)

    Dim target_range As String
        target_range = src_cell & ":" & src_column & DEM_ERow

        Sheets(src_sheetname).Range(target_range).Copy
        dst_sheetName.Range(dst_cell).PasteSpecial Paste:=xlPasteValues

End Sub

Private Sub COPY_CONST()

    Call CONST_DATA("J", "US")
    Call CONST_DATA("M", "'000000000")
    Call CONST_DATA("N", "'0")
    Call CONST_DATA("T", "'0")
    Call CONST_DATA("U", "'0000000.00")
    Call CONST_DATA("AR", "'0000000.00")
    Call CONST_DATA("AS", "'0000000.00")
    Call CONST_DATA("AT", "'0000000.00")
    Call CONST_DATA("AV", "'.00000")
    Call CONST_DATA("AZ", "'001")
    Call CONST_DATA("BC", "'0000000.00")
    Call CONST_DATA("BH", "'000000000.00")
    Call CONST_DATA("BI", "'0")
    Call CONST_DATA("BJ", "'.00000")
    Call CONST_DATA("BO", "'00")
    Call CONST_DATA("BP", "'0000000000000")
    Call CONST_DATA("BQ", "'0000000000000")
    Call CONST_DATA("BV", "'0.0000")
    Call CONST_DATA("CA", "'0000000.00")
    Call CONST_DATA("CB", "'0000000.00")
    Call CONST_DATA("CC", "'0000000.00")
    Call CONST_DATA("CE", "A")
    Call CONST_DATA("CF", "'1")
    Call CONST_DATA("CH", "'0000000.00000000")
    Call CONST_DATA("CI", "'.00000")
    Call CONST_DATA("CJ", "'000001")
    Call CONST_DATA("DD", "'000")
    Call CONST_DATA("DK", "'000")
    Call CONST_DATA("DA", "'3")
    Call CONST_DATA("FG", "8880")
    Call CONST_DATA("DI", "U")
    Call CONST_DATA("BF", Sheets("Home").Range("B6").Value)

End Sub

Private Sub CONST_DATA(ByVal dst_col As String, ByVal str_value As String)

    Dim target_range As String
        target_range = dst_col & "2:" & dst_col & (DEM_ERow - 2)

    Sheets(LFF_WS).Range(target_range).Value = str_value

End Sub

Private Sub CO_BUYER_CONST()

Sheets(LFF_WS).Select

Dim co_buyer_range As Range
    Set co_buyer_range = Sheets(LFF_WS).Range("AH2:AH" & DEM_ERow)

    For Each cell In co_buyer_range
        If IsEmpty(cell) = False Then
                Range("AG" & cell.Row).Value = "US"         'CO_BUYER_COUNTRY
                Range("AO" & cell.Row).Value = "'0001"      'COLL
                Range("AP" & cell.Row).Value = "'0"         'COMAKER_CE
        End If
    Next cell

End Sub

Private Sub CSC_AccountNubmer_EdgeCase(ByVal strRange As String)

    'Returns 7 digits from the CSC Account number
    Dim CSC_Range As Range
        Set CSC_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In CSC_Range
        cell.Value = Mid(cell.Value, 7, 7)
    Next cell

End Sub

Private Sub LateChgCode_EdgeCase(ByVal strRange As String)

        'Retrieves the state code from the state code list located in tab "Raw 1"
    Dim State_Code_Range As Range
        Set State_Code_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In State_Code_Range
        cell.Value = Application.Index(Sheets("Raw 1").Range("Y5:AE56"), Application.Match(cell.Value, Sheets("Raw 1").Range("Y5:Y56"), 0), 7)
    Next cell

End Sub

Private Sub Percent_EdgeCase(ByVal strRange As String)

    'Checks APR formatting and if not decimal, decimal
    Dim APR_Range As Range
        Set APR_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In APR_Range
        If cell.Value < 1 Then cell.Value = cell.Value * 100
        cell.NumberFormat = "0.00"
    Next cell

End Sub

Private Sub Make_Len_EdgeCase(ByVal strRange As String)

    'Returns 8 characters if the Make is greater than 8 characters
    Dim Make_Range As Range
        Set Make_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In Make_Range
        If Len(cell.Value) > 8 Then cell.Value = Left(cell.Value, 8)
    Next cell

End Sub

Private Sub Year_Len_EdgeCase(ByVal strRange As String)

    'Returns the year as YY if the format is YYYY
    Dim Year_Range As Range
        Set Year_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In Year_Range
        cell.NumberFormat = "@"
        If Len(cell.Value) > 2 Then cell.Value = Right(cell.Value, 2)
    Next cell

End Sub

Private Sub Notice_EdgeCase(ByVal strRange As String)

    'Returns the correct type based on the value in column DO
    Dim Notice_Range As Range
        Set Notice_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In Notice_Range

        If cell.Value = 12 Then
            cell.Value = "D"
        Else:
            cell.Value = "'2"
        End If

    Next cell

End Sub

Private Sub Freq_Code_EdgeCase(ByVal strRange As String)

    Dim Freq As Integer
    Dim Freq_Code_Range As Range
        Set Freq_Code_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In Freq_Code_Range

        Freq = cell.Value

        Select Case Freq
            Case Is = 12
                cell.Value = ""
            Case Is = 24
                cell.Value = "PFR2"
            Case Is = 26
                cell.Value = "PFR8"
            Case Else
                cell.Value = "PFR1"
        End Select

    Next cell

End Sub

Private Sub PMT_Freq_EdgeCase(ByVal strRange As String)

    Dim PMT_Freq As Variant 'integer or string
    Dim PMT_Freq_Range As Range
        Set PMT_Freq_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In PMT_Freq_Range

        PMT_Freq = cell.Value

        Select Case PMT_Freq

            Case Is = ""
                cell.Value = ""
            Case Is = 12
                cell.Value = "'3"
            Case Is = 24
                cell.Value = "'2"
            Case Is = 26
                cell.Value = "'8"
            Case Else
                cell.Value = "'1"

        End Select
    Next cell

End Sub


Private Sub State_Code_EdgeCase(ByVal strRange As String)

    'Retrieves the state code from the state code list located in tab "Raw 1"
    Dim State_Code_Range As Range
        Set State_Code_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow - 2)

    For Each cell In State_Code_Range
        cell.Value = Application.Index(Sheets("Raw 1").Range("Y5:AD56"), Application.Match(cell.Value, Sheets("Raw 1").Range("Y5:Y56"), 0), 6)
    Next cell

End Sub

Private Sub LR_IntDiscount_EdgeCase(ByVal strRange As String)

' there has to be a value to compare the loans to determine if we need this value or not

    Dim LR_IntDiscount_Range As Range
        Set LR_IntDiscount_Range = Sheets(LFF_WS).Range(strRange & "2:" & strRange & DEM_ERow)

    For Each cell In LR_IntDiscount_Range

        Select Case cell.Value
            Case Is = ""
                cell.Value = ""
            Case Is = 3
                cell.Value = ""
        End Select

    Next cell

End Sub


Private Sub SSN_EdgeCase(ByVal src_sheetname As String, ByVal src_cell As String, ByVal dst_cell As String)

    'copies and values and formatting of SSNs
    Dim dst_sheetName As Worksheet
        Set dst_sheetName = Sheets("Loan Feed File Output")

    Dim src_column As String

    src_column = Left(src_cell, Len(src_cell) - 1)

    Dim target_range As String
        target_range = src_cell & ":" & src_column & DEM_ERow

    Sheets(src_sheetname).Range(target_range).Copy
    dst_sheetName.Range(dst_cell).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        'returns dummy SSN if less than 9 chars
        Dim dst_range As String

        dst_range = dst_cell & "2:" & dst_cell & DEM_ERow - 2

        For Each cell In Sheets(LFF_WS).Range(dst_range)
            If Len(cell.Value) > 1 And Len(cell.Value) < 9 Then cell.Value = "999999999"
        Next cell

End Sub


Private Sub Integer_Extraction(ByVal col_Alpha As String)

    'Extracts the integers from phone numbers and SSN
    Dim strRange As String
        strRange = col_Alpha & "2:" & col_Alpha & DEM_ERow

    Dim target_range As Range
    Set target_range = Sheets(LFF_WS).Range(strRange)

    Dim strInt As String

    For Each cell In target_range
        strInt = ""

        For i = 1 To Len(cell.Value)

            If Mid(cell.Value, i, 1) >= "0" And Mid(cell.Value, i, 1) <= "9" Then
                strInt = strInt + Mid(cell.Value, i, 1)
            End If

        Next i

        cell.Value = strInt

    Next cell

End Sub


Private Sub date_format(ByVal col_Alpha As String)
    'returns int date as date
    Dim strRange As String
        strRange = col_Alpha & "2:" & col_Alpha & DEM_ERow

    Dim target_range As Range
    Set target_range = Sheets(LFF_WS).Range(strRange)

    target_range.NumberFormat = "m/d/yyyy"

End Sub


Private Sub Clear_Contents()

Dim target_range As Range
Set target_range = Sheets(LFF_WS).Range("A2:HD" & DEM_ERow - 2)

For Each cell In target_range

    If cell.Value = "" Then cell.ClearContents

Next cell

End Sub

Private Sub Edge_Cases()

    Call CSC_AccountNubmer_EdgeCase("A")
    Call Percent_EdgeCase("FF")
    Call Percent_EdgeCase("BK")
    Call Year_Len_EdgeCase("DC")
    Call Notice_EdgeCase("DO")
    Call Freq_Code_EdgeCase("CL")
    Call PMT_Freq_EdgeCase("DV")
    Call State_Code_EdgeCase("FI")
    Call Make_Len_EdgeCase("CY")
    Call LateChgCode_EdgeCase("BE")
    Call SSN_EdgeCase(PTI_WS, "CF2", "FH2")
    Call SSN_EdgeCase(DEM_WS, "BK4", "AB2")

End Sub

Private Sub Formatting()

    Call date_format("P")
    Call date_format("AW")
    Call date_format("BN")
    Call date_format("DN")
    Call date_format("EX")
    Call date_format("V")

    Call Integer_Extraction("FH")
    Call Integer_Extraction("BB")
    Call Integer_Extraction("Q")

End Sub

Answer 1

Your variable for DEM_ERow looks to be more complicated than it needs. DEM_ERow = wsDEM.Range("C4").End(xlDown).Row should produce the same row count.

---

A lot of your Subs were passing in both the sheet name and a string that represents the range. Assume you have Private Sub BoldHeaders(ByVal topLeftCell As Range). To use it in your code you'd see BoldHeaders Sheet1.Range("A1"). If you need to access something on the sheet you can access the Parent property on the range object topLeftCell.Parent.Range(...). This helps simplify your procedures signatures.

As @Raystafarian already mentioned in his answer don't use .Select. Instead access the member directly. Sheet1.Select followed by Selection.Range("A1") or Range("A1") which uses the implicit ActiveSheet both become the fully qualified Sheet1.Range("A1"). Doing what's been mentioned on Filter_Blank it becomes

Private Sub Filter_Blank(ByVal leftmostCellInHeader As Range, ByVal FilterIndex As Integer)
    Dim filterRange As Range
    Set filterRange = leftmostCellInHeader.Parent.Range(leftmostCellInHeader, leftmostCellInHeader.End(xlToRight))
    filterRange.AutoFilter Field:=FilterIndex, Criteria1:="<>"
End Sub

The filterRange variable is there to show how it compares with your original. It can ultimately become a single line leftmostCellInHeader.Parent.Range(leftmostCellInHeader, leftmostCellInHeader.End(xlToRight)).AutoFilter Field:=FilterIndex, Criteria1:="<>".

---

To continue on with refactoring (changing how code achieves the result without altering what is achieved) your code, lets look at format_data_tabs.You can update Sheets.Add and AcitveSheet.Name = ... to be a single line Sheets.Add.Name = ... since as far as I can tell nothing is being done with that sheet.

Applying refactoring to sort_Asc you can have it called sort_Asc wsPTI.Range("B1") where wsPTI is a worksheet variable that's been assigned by a line of code that I show later on.

Private Sub sort_Asc(ByVal headerOfFieldToFilter As Range)
    Dim target_range As Range
    Set target_range = headerOfFieldToFilter.Parent.Range(headerOfFieldToFilter, headerOfFieldToFilter.End(xlDown))

    With target_range.Parent.AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add Key:=target_range, Order:=xlAscending
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Those changes end up with

Private Sub format_data_tabs()
    If wsPTI.Visible <> xlSheetVisible Then
        wsPTI.Visible = xlSheetVisible
    End If

    'Insert Loan Feed File tab
    Dim loanFileFeed As Worksheet
    Set loanFileFeed = Sheets.Add
    loanFileFeed.Name = wsLFF.Name

    Filter_Blank wsDEM.Range("A3"), 13
    sort_Asc wsDEM.Range("D3")

    Filter_Blank wsPTI.Range("B1"), 10
    sort_Asc wsPTI.Range("B1")

    If Header_Verification = False Then End

    match_hide_records Sheets("DEM_NAME").Range("B2"), Sheets("PTI_NAME").Range("D4")
End Sub

A lot if this same refactoring can be applied throughout your code.

---

Looking at copy_paste you have the parameter dst_cell that's for the destinationCell. I suggest using the full descriptive name as it makes it easier to understand. The misleading part is what sheet this cell will be going to. You have to know what the internals are doing and that it has Dim dst_sheetName As Worksheet inside that's setting it to Sheets("Loan Feed File Output"). Refactoring ByVal dst_cell As String to ByVal destinationCell As Range you know which sheet the cell is coming from. My refactoring came up with

Private Sub copy_paste(ByVal sourceCell As Range, ByVal destinationCell As Range)
    Dim sourceRange As Range
    Set sourceRange = sourceCell.Parent.Range(sourceCell, sourceCell.Parent.Cells(DEM_ERow, sourceCell.Column))

    destinationCell.Resize(sourceRange.Rows.Count).Value2 = sourceRange.Value2
End Sub

The .Copy and .PasteSpecial Paste:=xlPasteValues amounted to destinationCell.Resize(sourceRange.Rows.Count).Value2 = sourceRange.Value2 since you're only concerned about migrating the values over. An example of how it's now used

Private Sub copy_data()
    Dim destinationSheet As Worksheet
    Set destinationSheet = Sheets("Loan Feed File Output")

    copy_paste wsDEM.Range("E4"), destinationSheet.Range("A2")
    ....
End Sub

---

Looking at CONST_DATA there is a surprise hiding inside of it. target_range = dst_col & "2:" & dst_col & (DEM_ERow - 2) has the 2 just in front of the colon and DEM_ERow - 2 begging to be converted into parameters that get supplied the values. This goes back to not needing to know implementation details, what's inside that's making it work. There were several other times that I did this for other Subs.

Private Sub CONST_DATA(ByVal updateSheet As Worksheet, ByVal destinationColumn As String, ByVal startRow As Long, ByVal endRow As Long, ByVal value As String)
    With updateSheet
        .Range(.Cells(startRow, destinationColumn), .Cells(endRow, destinationColumn)).Value2 = value
    End With
End Sub

Now when you call this sub you know that there's a start and end row that you're working with.

Private Sub COPY_CONST()
    Dim startRow As Long
    startRow = 2
    Dim endRow As Long
    endRow = DEM_ERow - 2

    Dim updateSheet As Worksheet
    Set updateSheet = wsLFF

    CONST_DATA updateSheet, "J", startRow, endRow, "US"
    ....
End Sub

---

CO_BUYER_CONST has Sheets(LFF_WS).Select hiding inside. A couple lines later you have Range(...) which relies on that .Select since it's implicitly using the ActiveSheet.

IsEmpty(cell) = False has been updated to Not IsEmpty(cell) since IsEmpty is a function that has a Boolean return value. Not makes a True -> False and False -> True.

Private Sub CO_BUYER_CONST(ByVal useRange As Range)
    Dim cell As Range
    For Each cell In useRange
        If Not IsEmpty(cell) Then
            With useRange.Parent
                .Range("AG" & cell.Row).value = "US"  'CO_BUYER_COUNTRY
                .Range("AO" & cell.Row).value = "'0001" 'COLL
                .Range("AP" & cell.Row).value = "'0"  'COMAKER_CE
            End With
        End If
    Next
End Sub

It's call site becomes CO_BUYER_CONST wsLFF.Range("AH2:AH" & DEM_ERow) letting you know what's going to be used.

---

The formatting call.

Private Sub date_format(ByVal useSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    useSheet.Range(useSheet.Cells(startRow, columnLetter), useSheet.Cells(endRow, columnLetter)).NumberFormat = "m/d/yyyy"
End Sub

Integer_Extraction was updated with a Regular Expression aka RegEx. To pull out the numbers. Regex are very powerful and very worthwhile to learn and I'd do a poor job explaining them.

Private Sub Integer_Extraction(ByVal useSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Extracts the integers from phone numbers and SSN
    With useSheet
        Dim target_range As Range
        Set target_range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim strInt As String
    Dim cell As Range
    For Each cell In target_range
        strInt = ""
        strInt = RegexNumberExtraction(cell.Value2)
        cell.value = strInt
    Next
End Sub

'https://stackoverflow.com/questions/4187356/regular-expression-to-extract-numbers-from-a-string
Private Function RegexNumberExtraction(ByVal value As String) As Long
    'To enable early binding which provides intellisense
    'Tools>References>Microsoft VBScript Regular Expressions 5.5
    'Currently late bound and doesn't need a reference set
    Dim foo As Object 'VBScript_RegExp_55.RegExp
    Set foo = CreateObject("vbscript.regexp") 'New VBScript_RegExp_55.RegExp
    foo.Global = True
    foo.Pattern = "[0-9]+"

    Dim bar As Object
    Set bar = foo.Execute(value)

    Dim extractedNumbers As String
    Dim i As Long
    For i = 0 To bar.Count - 1
        extractedNumbers = extractedNumbers & bar(i)
    Next

    RegexNumberExtraction = CLng(extractedNumbers)
End Function

Call site ends up looking like

Private Sub Formatting()
    Dim startRow As Long
    startRow = 2
    Dim endRow As Long
    endRow = DEM_ERow

    Dim useSheet As Worksheet
    Set useSheet = wsLFF

    date_format useSheet, "P", startRow, endRow
    ...

    Integer_Extraction useSheet, "FH", startRow, endRow
    ...
End Sub

---

All your subs with _EdgeCase I moved to a dedicated module named EdgeCases. LR_IntDiscount_EdgeCase was never used and was commented out.

'EdgeCases module
Public Sub CSC_AccountNubmer(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)

    'Returns 7 digits from the CSC Account number
    Dim CSC_Range As Range
    With updateSheet
        Set CSC_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In CSC_Range
        cell.value = Mid$(cell.value, 7, 7)
    Next
End Sub

Public Sub LateChgCode(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Retrieves the state code from the state code list located in tab "Raw 1"

    Dim matchLookupValues As Range
    Set matchLookupValues = Sheets("Raw 1").Range("Y5:Y56")
    Const EXACT_MATCH As Long = 0

    Dim indexLookupValues As Range
    Set indexLookupValues = Sheets("Raw 1").Range("AE5:AE56")

    Dim State_Code_Range As Range
    With updateSheet
        Set State_Code_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim foundOnRow As Double
    Dim cell As Range
    For Each cell In State_Code_Range
        foundOnRow = WorksheetFunction.Match(cell.value, matchLookupValues, EXACT_MATCH)
        cell.value = WorksheetFunction.Index(indexLookupValues, foundOnRow)
    Next
End Sub

Public Sub Percentage(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)

    'Checks APR formatting and if not decimal, decimal
    Dim APR_Range As Range
    With updateSheet
        Set APR_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In APR_Range
        If cell.value < 1 Then
            cell.value = cell.value * 100
        End If
        cell.NumberFormat = "0.00"
    Next
End Sub

Public Sub Make_Len(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Returns 8 characters if the Make is greater than 8 characters
    Dim Make_Range As Range
    With updateSheet
        Set Make_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In Make_Range
        If Len(cell.value) > 8 Then
            cell.value = Left$(cell.value, 8)
        End If
    Next
End Sub

Public Sub Year_Len(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Returns the year as YY if the format is YYYY
    Dim Year_Range As Range
    With updateSheet
        Set Year_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In Year_Range
        cell.NumberFormat = "@"
        If Len(cell.value) > 2 Then
            cell.value = Right$(cell.value, 2) 'possibly use Format$(cell.value,"YY")
        End If
    Next
End Sub

Public Sub Notice(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Returns the correct type based on the value in column DO
    Dim Notice_Range As Range
    With updateSheet
        Set Notice_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With
    Dim cell As Range
    For Each cell In Notice_Range
        If cell.value = 12 Then
            cell.value = "D"
        Else
            cell.value = "'2"
        End If
    Next
End Sub
Public Sub Freq_Code(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)

    Dim Freq As Long
    Dim Freq_Code_Range As Range
    With updateSheet
        Set Freq_Code_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In Freq_Code_Range

        Freq = cell.value

        Select Case Freq
            Case Is = 12
                cell.value = ""
            Case Is = 24
                cell.value = "PFR2"
            Case Is = 26
                cell.value = "PFR8"
            Case Else
                cell.value = "PFR1"
        End Select
    Next
End Sub

Public Sub PMT_Freq_EdgeCase(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)

    Dim PMT_Freq As Variant                      'integer or string
    Dim PMT_Freq_Range As Range
    With updateSheet
        Set PMT_Freq_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    For Each cell In PMT_Freq_Range

        PMT_Freq = cell.value

        Select Case PMT_Freq

        Case Is = ""
            cell.value = ""
        Case Is = 12
            cell.value = "'3"
        Case Is = 24
            cell.value = "'2"
        Case Is = 26
            cell.value = "'8"
        Case Else
            cell.value = "'1"
        End Select
    Next

End Sub

Public Sub State_Code(ByVal updateSheet As Worksheet, ByVal columnLetter As String, ByVal startRow As Long, ByVal endRow As Long)
    'Retrieves the state code from the state code list located in tab "Raw 1"
    Dim matchLookupValues As Range
    Set matchLookupValues = Sheets("Raw 1").Range("Y5:Y56")
    Const EXACT_MATCH As Long = 0

    Dim indexLookupValues As Range
    Set indexLookupValues = Sheets("Raw 1").Range("AD5:AD56")

    Dim State_Code_Range As Range
    With updateSheet
        Set State_Code_Range = .Range(.Cells(startRow, columnLetter), .Cells(endRow, columnLetter))
    End With

    Dim cell As Range
    Dim foundOnRow As Double
    For Each cell In State_Code_Range
        foundOnRow = WorksheetFunction.Match(cell.value, matchLookupValues, EXACT_MATCH)
        cell.value = WorksheetFunction.Index(indexLookupValues, foundOnRow)
    Next
End Sub

'Private Sub LR_IntDiscount_EdgeCase(ByVal columnLetter As String)
'    ' there has to be a value to compare the loans to determine if we need this value or not
'    Dim LR_IntDiscount_Range As Range
'    Set LR_IntDiscount_Range = wslff.Range(columnLetter & "2:" & columnLetter & DEM_ERow)
'
'    Dim cell As Range
'    For Each cell In LR_IntDiscount_Range
'        Select Case cell.Value
'            Case Is = "", Is = 3
'                cell.Value = ""
'        End Select
'    Next
'
'End Sub

Public Sub SSN_EdgeCase(ByVal sourceSheet As Worksheet, ByVal sourceColumnLetter As String, ByVal sourceStartRow As Long, ByVal sourceEndRow As Long, _
                        ByVal destinationSheet As Worksheet, ByVal destinationColumnLetter As String, ByVal destinationStartRow As Long, ByVal destinationEndRow As Long)
    'copies and values and formatting of SSNs
    'returns dummy SSN if less than 9 chars
    Const dummySSN As String = "999999999"

    Dim copyRange As Range
    With sourceSheet
        Set copyRange = .Range(.Cells(sourceStartRow, sourceColumnLetter), .Cells(sourceEndRow, sourceColumnLetter)).Copy
    End With

    copyRange.Copy
    destinationSheet.Range(destinationColumnLetter).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

    Dim destination As Range
    With destinationSheet
        Set destination = .Range(.Cells(destinationStartRow, destinationColumnLetter), .Cells(destinationEndRow, destinationColumnLetter))
    End With

    Dim cell As Range
    For Each cell In destination
        If Len(cell.value) > 1 And Len(cell.value) < 9 Then
            cell.value = dummySSN
        End If
    Next
End Sub

Now called as ModuleName.SubProcedureName

Private Sub Edge_Cases()
    Dim startRow As Long
    startRow = 2

    Dim endRow As Long
    endRow = DEM_ERow - 2

    Dim updateSheet As Worksheet
    Set updateSheet = wsLFF

    EdgeCases.CSC_AccountNubmer updateSheet, "A", startRow, endRow
    ...

    EdgeCases.SSN_EdgeCase wsPTI, "CF", 2, DEM_ERow, Sheets("Loan Feed File Output"), "FH2", startRow, endRow
    ...
End Sub

---

Circling back to the start of all of your code it now has 3 private variables for the worksheets in place of passing the names around. They are assigned at the start. I assumed that DEM_ERow can be made private.

Private DEM_ERow As Long
Private wsDEM As Worksheet
Private wsPTI As Worksheet
Private wsLFF As Worksheet

Sub GenerateLFF()
    Set wsDEM = Sheets("DEM_NAME")
    Set wsPTI = Sheets("PTI_NAME")
    Set wsLFF = Sheets("LFF_NAME")

    'last row of DEM
    DEM_ERow = wsDEM.Range("C4").End(xlDown).Row

    performance_Opt True
    format_data_tabs
    copy_data
    COPY_CONST
    CO_BUYER_CONST wsLFF.Range("AH2:AH" & DEM_ERow)
    Edge_Cases
    Formatting
    Clear_Contents wsLFF, 2, DEM_ERow - 2
    performance_Opt False
End Sub

---

These are any Subs I didn't comment on directly or forgot to mention in their respective spots.

Private Sub match_hide_records(ByVal broadCell As Range, ByVal narrowCell As Range)
    Dim broadList As Range
    Set broadList = broadCell.Parent.Range(broadCell, broadCell.End(xlDown))

    Dim narrowList As Range
    Set narrowList = narrowCell.Parent.Range(narrowCell, narrowCell.End(xlDown))

    'match and hide
    Dim cell As Range
    For Each cell In broadList
        Dim isFound As Range
        Set isFound = narrowList.Find(cell.value, LookIn:=xlFormulas, LookAt:=xlWhole)
        If isFound Is Nothing Then
            cell.EntireRow.Hidden = True
        End If
    Next
End Sub

I believe that Clear_Contents can be removed entirely. From what I've seen PMT_Freq_EdgeCase and Freq_Code are using it to assign the cell value. Note that vbNullString achieves the same thing and it's not ambiguous if there was something inside the quotes that was accidentally removed. Seeing cell.Value2 = vbNullString leaves no doubt it was intentional whereas cell.Value2 = "" leaves me wondering. I'm assuming you're doing this to still allow use of the range being contiguous and Range.End(). Best bet IMO is to cell.ClearContents and refactor your code so that it's not using this temp solution. Without seeing your sheet this is as far as I can confidently make suggestions.

---

The Rubberduck addin for the VBA IDE caught the following I missed with its Code Inspections:

• Mid$(), Left$(), Right$()
• Missing ByVal on several parameters performance_Opt(TurnOn As Boolean) is one. It also comes up with the implicitly passed by reference
• FilterIndex As Integer Integers can/should be declared as Long unless mandated to be Integer.
• performance_Opt is implicitly public because it's missing an access modifier. GenerateLFF should be prefaced with Public to make it explicitly known that it's public (assuming you're calling it via a button).
• Lots of implicit references of ActiveWorkbook on Sheets. I'd say they can all be made Worksheets calls.

Full disclosure. I'm a contributor and openly biased in favor of it. Code Inspections are just one part of RD.

Answer 2

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Current "variables" undeclared - wsdem,wspti, DEM_NAME, PTI_NAME, cell, cell_match, i

When you don't define your variable, VBA will declare it as a Variant type that can hold any type of data. While this may be more flexible, it adds processing time to your macro as VBA decides or tests for the type. Additionally, since a Variant can be any type of data, you may miss out on valuable troubleshooting information on Type Mismatch

Something to help with all that worksheet variable stuff - Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

---

You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

---

Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

So Dim Wrong as String would be wrong. Additionally, something like target_range wouldn't use the underscore.

---

Private Function Header_Verification() As Boolean

I'm not sure how this works, you aren't passing any parameters to the function, but it's returning a boolean. So I can call it from anywhere and it will only test the same thing. Even if it's obvious, a function should take a parameter, even if you just pass the sheets to it.

Sub performance_Opt(TurnOn As Boolean)

You're passing this ByRef. VBA implicitly sends arguments ByRef unless you tell it ByVal. So even if it's supposed to be ByRef, put that in there to avoid confusion. But, most the time you can use ByVal.

---

Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this. This goes for all that copying and pasting as well as filtering. You can do all of that on the data itself rather than the sheets. For instance with copy_data -

Private Sub copy_data()

    Call copy_paste(DEM_WS, "E4", "A2")
    Call copy_paste(DEM_WS, "F4", "B2")
    ...
    Call copy_paste(DEM_WS, "R4", "DV2")

End Sub

What I would suggest is to create some arrays, like this -

Const DEM_CELLS_FROM As String = "E4, F4, G4, BL4, BJ4, BH4, BE4, BF4, BI4, J4, AO4, BP4, BT4, BV4, BO4, BS4, BU4, BN4, BR4, AN4, H4, H4, M4, K4, AM4, AL4, T4, R4, R4, T4, Q4, L4, R4"
Const DEM_CELLS_TO As String = "A2, B2, C2, V2, AC2, AE2, AH2, AK2, AN2, FK2, FN2, EX2, EY2, EZ2, DZ2, EA2, EB2, EH2, EI2, DB2, AW2, DN2, DY2, BK2, CY2, DC2, BE2, DO2, CL2, FI2, FJ2, FS2, DV2"
Dim demSource As Variant
Dim demTarget As Variant
demSource = Split(DEM_CELLS_FROM, ",")
demTarget = Split(DEM_CELLS_TO, ",")

Now you can pull the data into source, change it, populate target and spit it back. Or, if you're not changing anything, a simple loop would work

With wsdem
    For i = LBound(demSource) To UBound(demSource)
        .Range(demTarget(i)) = .Range(demSource(i))
    Next
End With

This doesn't affect the speed (as in make it faster), but it looks cleaner. Either way you could use the loop to do the copy_paste if you didn't change anything else.

This applies to most of your other subs as well. However, what I would do is some variation of this -

Dim lastRow As Long
Dim lastColumn As Long
lastRow = wsdem.Range(wsdem.Rows.Count, 1).End(xlUp).Row
lastColumn = wsdem.Range(1, wsdem.Columns.Count).End(xlUp).Column
Dim demData As Variant
demData = wsdem.Range(wsdem.Cells(1, 1), wsdem.Cells(lastRow, lastColumn))

So now all the data is in an array. Do that for each sheet. Then you can do your matching in the arrays instead of on the sheet -

Dim hiddenRows() As Long
Dim i As Long
For i = LBound(firstarray) To UBound(firstarray)
    For j = LBound(secondarray) To UBound(secondarray)
        If firstarray(i) = secondarray(j) Then
            ReDim Preserve hiddenRows(UBound(hiddenRows) + 1)
            hiddenRows(UBound(hiddenRows)) = j 'or whatever
            skipnext
        End If
    Next
skipnext:
Next

Now you can just get the rows numbers when you need them and hide them later. Or you create it as an index to not test in your arrays. It's not a 1:1 example of your data, but the concept is the same - the less you do on the sheet the faster it will be.

---

Your Header_Verification sub, well I see what you're doing. This is an example of using arrays for storing addresses and strings, comparing them and using another array for the details e.g.

Const DEM_RANGE1 As String = "AL3, AM3, AN3"
Const PTI_RANGE1 As String = "BQ1, BR1, BS1, BT1, BU1, BV1"

Const DEM_HEADERS1 As String = "CSC Account Number , Last Name , First Name , Loan Date , APR , Amt Financed , Number of Payments , Freq"
Const PTI_HEADERS1 As String = "Cus Address , City, State, Zip Code, Phone, Phone"

Const DEM_RANGE2 As String = "AL3, AM3, AN3"
Const DEM_HEADERS2 As String = "Vehicle Year , Make , Model"

Const DEM_RANGE3 As String = "AO3, BE3, BF3, BG3, BH3, BI3, BJ3, BK3, BL3, BM3, BN3, BO3, BP3, BQ3, BR3, BS3, BT3, BV3"
Const DEM_HEADERS3 As String = "Vin , Co- buyer First Name, Co Buyer Last Name, CoBuyer Address, Co Buyer City, Co Buyer State, Co Buyer Zip, Co Buyer Social, Co Buyer DOB, Schedule 1 PMT Freq, Schedule 1 Number of PMT's, Schedule 1 PMT Amount, Schedule 1 PMT Start Date, Schedule 2 PMT Freq, Schedule 2 Number of PMT's, Schedule 2 PMT Amount, Schedule 2 PMT Start Date, Schedule 3 PMT Start Date"

Const PTI_RANGE2 As String = "CD1, CF1, CG1"
Const PTI_HEADERS2 As String = "Employer Phone, Social Security #, Date of Birth"

Then split them into arrays

Dim demCells As String
demCells = Split(DEM_RANGE1, ",")
Dim demHeaders As String
demHeaders = Split(DEM_HEADERS1, ",")

Dim i As Long
For i = LBound(demCells) To UBound(demCells)
    If Not wsdem.Range(demCells(i)) = demHeaders(i) Then Debug.Print "Error at " & demHeaders(i)
Next

What you could also do is just use the header array to populate the headers.

So my example don't have you taking the majority of the work off the sheet, but I have given you an idea on how to accomplish that.