This function conditionally copies and pastes information from one sheet to another based on the column headings to standardize data before exported to SQL database.I am not an expert in VBA and started learning but when I run this code, it takes way too long to process huge data (ex: Excel sheet with 70k rows would take like 2 minutes to 5 minutes). Can anyone make a suggestion to make it time-efficient?Option ExplicitPublic Sub projectionTemplateFormat()    Dim t1 As Double, t2 As Double    xlSpeed True        t1 = Timer        'On Error Resume Next        mainProcess        'On Error GoTo 0        t2 = Timer    xlSpeed False    MsgBox Duration:  & t2 - t1 &  secondsEnd SubPrivate Sub mainProcess()    Const SPACE_DELIM   As String =      Dim wsIndex             As Worksheet    Dim wsImport            As Worksheet    'Raw    Dim wsFinal             As Worksheet    Dim indexHeaderCol      As Range    Dim msg                 As String    Dim importHeaderRng     As Range    Dim importColRng        As Range    Dim importHeaderFound   As Variant    Dim importLastRow       As Long    Dim finalHeaderRng      As Range    Dim finalColRng         As Range    Dim finalHeaderRow      As Variant    Dim finalHeaderFound    As Variant    Dim header              As Variant      'Each item in the FOR loop    Dim lastRow As Long  'Manual Headers based on the number of rows in the raw data    Dim rngs As Range    Set wsIndex = aIndex    'This is the Code Name; top-left pane: aIndex (Index)    Set wsImport = bImport  'Direct reference to Code Name: bImport.Range(A1)    Set wsFinal = cFinal    'Reference using Sheets collection: ThisWorkbook.Worksheets(Final)    Set rngs = ThisWorkbook.Sheets(DATA).Cells    lastRow = rngs.Find(What:=*, After:=rngs.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1    '+ 1 is added for dummy row in the final sheet; otherwise it won't copy the last row in the import sheet    'Static Data(Account Level information)    wsFinal.Range(D3:D & lastRow).Value = Sheets(INDEX).Range(H2).Value    wsFinal.Range(AD3:AD & lastRow).Value = Sheets(INDEX).Range(H3).Value    wsFinal.Range(X3:X & lastRow).Value = Sheets(INDEX).Range(H4).Value    wsFinal.Range(Y3:Y & lastRow).Value = Sheets(INDEX).Range(H5).Value    wsFinal.Range(AF3:AF & lastRow).Value = Sheets(INDEX).Range(H6).Value    wsFinal.Range(AG3:AG & lastRow).Value = Sheets(INDEX).Range(H7).Value    wsFinal.Range(AE3:AE & lastRow).Value = Sheets(INDEX).Range(H8).Value    wsFinal.Range(F3:F & lastRow).Value = Sheets(INDEX).Range(H9).Value    wsFinal.Range(AC3:AC & lastRow).Value = Sheets(INDEX).Range(H10).Value    'Claim Type    wsFinal.Range(E3:E & lastRow).Value = AB    With wsImport.UsedRange        Set importHeaderRng = .Rows(1)      'Import - Headers        importLastRow = .Rows.Count + 1         'Import - Total Rows; + 1 is for taking into consideration of the dummy row in the final sheet    End With    With wsFinal.UsedRange        finalHeaderRow = .Rows(1)           'Final - Headers (as Array)        Set finalHeaderRng = .Rows(1)       'Final - Headers (as Range)    End With    With wsIndex.UsedRange  'Transpose col 3 from Index (without the header), as column names in Import        Set indexHeaderCol = .Columns(3).Offset(1, 0).Resize(.Rows.Count - 1, 1)        wsImport.Range(wsImport.Cells(1, 1), wsImport.Cells(1, .Rows.Count - 1)).Value2 = Application.Transpose(indexHeaderCol)    End With    If Len(aIndex.Cells(1, 1).Value2) > 0 Then 'if index cell (1,1) is not empty        With Application            For Each header In finalHeaderRow   'Loop through all headers in Final                If Len(Trim(header)) > 0 Then   'If the Final heade is not empty                    importHeaderFound = .Match(header, importHeaderRng, 0)          'Find header in Import sheet                    If IsError(importHeaderFound) Then                        msg = msg & vbLf & header & SPACE_DELIM & wsImport.Name     'Import doesn't have current header                    Else                        finalHeaderFound = .Match(header, finalHeaderRng, 0)        'Find header in Final sheet                        If IsError(finalHeaderFound) Then                            msg = msg & vbLf & header & SPACE_DELIM & wsFinal.Name  'Import doesn't have current header                        Else                            With wsImport                                Set importColRng = .UsedRange.Columns(importHeaderFound).Offset(1, 0).Resize(.UsedRange.Rows.Count - 1, 1)                            End With                            With wsFinal                                Set finalColRng = .Range(.Cells(3, finalHeaderFound), .Cells(importLastRow, finalHeaderFound)) 'Change 3 to 2 if the dummy row is not included                                finalColRng.Value2 = vbNullString                   'Delete previous values (entire column)                            End With                            finalColRng.Value2 = importColRng.Value2             'Copy Import data in Final columns                        End If                    End If                End If            Next header        End With        ConvertToUppercase        extractYearsDim i As Long       For i = 3 To lastRow          If Not (wsFinal.Cells(i, Q).Value <= 2015 And wsFinal.Cells(i, Q).Value >= 1910) Then            With wsFinal                .Cells(i, Q).ClearContents            End With          End If       Next i       Dim j As Long          For j = 3 To lastRow          If Not (wsFinal.Cells(j, R).Value <= 2015 And wsFinal.Cells(j, R).Value >= 1910) Then            With wsFinal                .Cells(j, R).ClearContents            End With          End If       Next j          wsFinal.Columns(G).NumberFormat = @          wsFinal.Columns(I).NumberFormat = MM/DD/YYYY          wsFinal.Columns(K).NumberFormat = MM/DD/YYYY          wsFinal.Columns(A).NumberFormat = @          wsFinal.Columns(B).NumberFormat = @          wsFinal.Columns(C).NumberFormat = @          'wsFinal.Columns(R).NumberFormat = @          'wsFinal.Columns(Q).NumberFormat = @          wsFinal.Columns(J).NumberFormat = @          wsFinal.Columns(L).NumberFormat = @          wsFinal.Columns(T).NumberFormat = MM/DD/YYYY          wsFinal.Columns(W).NumberFormat = MM/DD/YYYY          wsFinal.Columns(V).NumberFormat = MM/DD/YYYY          wsFinal.Columns(AD).NumberFormat = MM/DD/YYYY          wsFinal.Columns(N).NumberFormat = _($* #,##0.00_);_($* (#,##0.00);_($* -??_);_(@_)          wsFinal.Columns(AN).NumberFormat = _($* #,##0.00_);_($* (#,##0.00);_($* -??_);_(@_)          wsFinal.Columns(AO).NumberFormat = _($* #,##0.00_);_($* (#,##0.00);_($* -??_);_(@_)          wsFinal.Columns(AP).NumberFormat = _($* #,##0.00_);_($* (#,##0.00);_($* -??_);_(@_)          'wsFinal.Columns(AQ).NumberFormat = General applyFormat wsFinal.Range(wsFinal.Cells(2, 1), wsFinal.Cells(importLastRow, wsFinal.UsedRange.Columns.Count))    Dim ws As Worksheet       For Each ws In Worksheets       ws.Select       ActiveWindow.Zoom = 90    Next ws    Else        MsgBox Missing raw data (Sheet 2 - 'Import'), vbInformation,    Missing Raw Data    End IfEnd SubFunction 2 Private Sub extractYears()        Dim arr As Variant, i As Long, j As Long, ur As Range, colW As Long, colV As Long        Set ur = cFinal.UsedRange                   '3rd sheet        If WorksheetFunction.CountA(ur) > 0 Then            colW = colNum(Q)            colV = colNum(R)            arr = ur                                'transfer sheet data to memory            For i = 3 To getMaxCell(ur).Row         'each row                If Len(arr(i, colW)) > 0 Then       'if not empty                    If Len(arr(i, colW)) > 4 Then   'if it's full date (longer than 4 digits)                        arr(i, colW) = Format(arr(i, colW), yyyy) 'extract the year part                    End If                End If                              'if it contains 4 digit year leave it as is                If Len(arr(i, colV)) > 0 Then       'the same logic applied for colV                    If Len(arr(i, colV)) > 4 Then                        arr(i, colV) = Format(arr(i, colV), yyyy)                    End If                End If            Next            ur = arr                                'transfer memory data back to sheet        End If    End SubFunction 2Private Sub applyFormat(ByRef rng As Range)    With rng        '.ClearFormats        With .Font            .Name = Georgia            .Color = RGB(0, 0, 225)        End With        .Interior.Color = RGB(216, 228, 188)        With .Rows(1)            .Font.Bold = True            .Interior.ColorIndex = xlAutomatic        End With        With .Borders            .LineStyle = xlDot  'xlContinuous            .ColorIndex = xlAutomatic            .Weight = xlThin        End With    End With    refit rngEnd SubSub ConvertToUppercase()   Dim ws As Object   Dim LCell As Range   'Move through each sheet in your spreadsheet      On Error Resume Next      ActiveWorkbook.Sheets(FINAL).Activate      'Convert all constants and text values to proper case      For Each LCell In Cells.SpecialCells(xlConstants, xlTextValues)         LCell.Formula = UCase(LCell.Formula)      NextEnd Sub
Transferring information between sheets based on column headings
vba;excel