I have this Excel/VBA code and here is what it does:I have 3 sheets, where first sheet has two columns that will be used (A,C).2nd Sheet is just the raw data file that will be imported from external source.3rd sheet is the final output.Column A in the first sheet is Raw Column Headings where the column headers from raw data table are copied, transposed, and pasted. Third column in the first sheet is the final headers that I need the raw ones to be changed to.Then, I will run a macro which will copy the final headers into the first row of second sheet and then copy/paste the entire columns with the certain headers specified in the code to the final output.The problem is that this process takes about 20~30 seconds per file and I have so many files to be processed. Can anyone take a look at the code and tell me how it can be done faster?Option ExplicitPrivate Function GetHeaders() As Collection    Dim result As New Collection    With result        .Add Account_ID        .Add Claim_ID        .Add Account_Name        .Add Claim_Type        .Add Coverage        .Add Claim_Level        .Add Claim_Count        .Add File_Date        .Add File_Year        .Add Resolution_Date        .Add Resolution_Year        .Add Claim_Status        .Add Indemnity_Paid        .Add Disease_Category        .Add State_Filed        .Add First_Exposure_Date        .Add Last_Exposure_Date        .Add Claimant_Employee        .Add Claimant_DOB        .Add Claimant_Deceased        .Add Claimant_Name        .Add Claimant_DOD        .Add Claimant_Diagnosis_Date        .Add Product_Type        .Add Product_Line        .Add Company/Entity/PC        .Add Plaintiff_Law_Firm        .Add Asbestos_Type        .Add Evaluation_Date        .Add Tier        .Add Data_Source        .Add Data_Source_Category        .Add Jurisdiction/County        .Add Settlement_Demand        .Add Jury_Verdict        .Add Exposure_Site        .Add National_Defendant_Firm        .Add Local_Defendant_Firm        .Add Expense_Amount        .Add NCC_Expense_Amount        .Add Non_NCC_Expense_Amount    End With    Set GetHeaders = resultEnd FunctionPrivate Function FindHeaderRange(ByVal ws As Worksheet, ByVal header As String) As Range    Set FindHeaderRange = ws.Cells.Find(header, , , xlWhole)End FunctionPrivate Function BuildMessage(ByVal currentMessage As String, ByVal ws As Worksheet, ByVal header As String) As String    BuildMessage = currentMessage & vbLf & header & Space(1) & ws.NameEnd FunctionPublic Sub ProjectionTemplateFormat()On Error GoTo ExitSub    Sheets(1).Range(C2, Cells(Rows.Count, C).End(xlUp)).Copy    Sheets(2).Range(A1).PasteSpecial transpose:=True    Range(A1).ClearOutline    Dim headers As Collection    Set headers = GetHeaders    Dim msg As String    Dim wsImport As Worksheet, wsMain As Worksheet    Set wsImport = ThisWorkbook.Sheets(2)    Set wsMain = ThisWorkbook.Sheets(3)    Application.ScreenUpdating = False    Dim header As Variant    Dim source As Range    Dim dest As Range    For Each header In headers        Set source = FindHeaderRange(wsImport, header)        If source Is Nothing Then            msg = BuildMessage(msg, wsImport, header)        Else            Set dest = FindHeaderRange(wsMain, header)            If dest Is Nothing Then                msg = BuildMessage(msg, wsMain, header)            Else                wsImport.Range(source.Offset(1), wsImport.Cells(Rows.Count, source.Column).End(xlUp)).Copy _                    wsMain.Cells(Rows.Count, dest.Column).End(xlUp)(2)            End If        End If    NextWith wsMain    .Columns(A:AO).AutoFit    .Cells.ClearFormats    .Rows(1).Font.Bold = True    .Cells.Font.Name = Georgia    .Cells.Font.Color = RGB(0, 0, 225)    .Cells.Resize(wsMain.Rows.Count - 1).Offset(1).Interior.Color = RGB(216, 228, 188)End With'Apply StyleDim ws As Worksheet    For Each ws In Worksheets        ws.Select        ActiveWindow.Zoom = 85    Next wsDim rng As RangeSet rng = wsMain.CellsWith rng.Borders    .LineStyle = xlDot    .Weight = xlThinEnd WithDim cell As Range    For Each cell In Range($A$2: & Range($A$2).SpecialCells(xlLastCell).Address)        If Len(cell) > 0 Then cell = UCase(cell)    Next cellExitSub:    Application.ScreenUpdating = TrueEnd Sub
Conditionally copy columns
performance;vba;excel
Previous answer is getting a bit long, so here is the rest of the code and the flow I'd suggest:.Option ExplicitPublic Sub mainProcess()    ProjectionTemplateFormatEnd SubPrivate Function GetHeaders() As Collection    '...End FunctionPrivate Sub ProjectionTemplateFormat()    GetHeaders    '...    applyFormat ThisWorkbook.Worksheets(1)End SubPrivate Sub applyFormat(ByRef sh As Worksheet)    With sh.UsedRange        .Columns.AutoFit        .ClearFormats        With .Font            .Name = Georgia            .Color = RGB(0, 0, 225)        End With        With .Borders            .LineStyle = xlDot            .Weight = xlThin        End With        .Interior.Color = RGB(216, 228, 188)        With .Rows(1)            .Font.Bold = True            .ColorIndex = xlAutomatic        End With    End With    Dim ws As Worksheet    For Each ws In Worksheets        ws.Zoom = 85    Next    allUpper1 sh   'or allUpper2 shEnd SubPrivate Sub allUpper1(ByRef sh As Worksheet) 'FOR loop, with VBA UCase()    Dim arr As Variant, i As Long, j As Long    If WorksheetFunction.CountA(sh.UsedRange) > 0 Then        arr = sh.UsedRange  'one interaction with the sheet        For i = 2 To UBound(arr, 1)         'each row            For j = 1 To UBound(arr, 2)     'each col                arr(i, j) = UCase(arr(i, j))            Next        Next        sh.UsedRange = arr  'second interaction with the sheet    End IfEnd SubPrivate Sub allUpper2(ByRef sh As Worksheet) 'No loop, with Excel UPPER()    Const FIRST_ROW As Long = 2    Dim lRow    As Long    Dim lCol    As Long    Dim usedRng As Range    Dim tempRng As Range    If WorksheetFunction.CountA(sh.UsedRange) > 0 Then        Set usedRng = sh.UsedRange        With usedRng            lRow = .Rows.Count            lCol = .Columns.Count        End With        'remove header row from working range        Set usedRng = usedRng.Offset(1, 0).Resize(lRow - 1, lCol)        'offset cell: 2 collumns to the right of 1st cell in used range        Set tempRng = sh.Cells(FIRST_ROW, lCol + 2)        With tempRng            'apply formula to offset cell: UPPER(A2)            .Formula = =Upper( & sh.Cells(FIRST_ROW, 1).Address(0, 0) & )            'fill down the column            .AutoFill Destination:=sh.Range(tempRng, .Offset(lRow, 0)), Type:=xlFillDefault            'fill right all rows            sh.Range(tempRng, .Offset(lRow, 0)).AutoFill Destination:=sh.Range(tempRng, .Offset(lRow, lCol)), Type:=xlFillDefault            With sh.Range(tempRng, .Offset(lRow, lCol))                usedRng.Value2 = .Value2    'copy upper case values back                .EntireColumn.Delete        'remove temp range            End With        End With    End IfEnd Sub.As a performance reference - measurement between UCase(), and UPPER() methods:FOR loop method:       6.61 secondsExcel formula method: 15.29 secondsWith 100,000 rows, and 26 columnsMost text cells contain Test Cell 1, Test Cell 2, Test Cell 3,..., and 11 cells with numbers, 5 in the first few rows and 6 in the last rows