Sub Standardization() Dim myHeaders, e, x, wsImport As Worksheet, wsMain As Worksheet Dim r As Range, c As Range myHeaders = Array(Array("Account_ID", "Account_ID"), Array("Claim_ID", "Claim_ID"), Array("Account_Name", "Account_Name"), _ Array("Claim_Type", "Claim_Type"), Array("Coverage", "Coverage"), Array("Claim_Level", "Claim_Level"), Array("Claim_Count", "Claim_Count"), _ Array("File_Date", "File_Date"), Array("File_Year", "File_Year"), Array("Resolution_Date", "Resolution_Date"), _ Array("Resolution_Year", "Resolution_Year"), Array("Claim_Status", "Claim_Status"), Array("Indemnity_Paid", "Indemnity_Paid"), _ Array("Disease_Category", "Disease_Category"), Array("State_Filed", "State_Filed"), Array("First_Exposure_Date", "First_Exposure_Date"), _ Array("Last_Exposure_Date", "Last_Exposure_Date"), Array("Claimant_Employee", "Claimant_Employee"), Array("Claimant_DOB", "Claimant_DOB"), _ Array("Claimant_Deceased", "Claimant_Deceased"), Array("Claimant_DOD", "Claimant_DOD"), Array("Claimant_Diagnosis_Date", "Claimant_Diagnosis_Date"), _ Array("Product_Type", "Product_Type"), Array("Product_Line", "Product_Line"), Array("Company/Entity/PC", "Company/Entity/PC"), _ Array("Plaintiff_Law_Firm", "Plaintiff_Law_Firm"), Array("Asbestos_Type", "Asbestos_Type"), Array("Evaluation_Date", "Evaluation_Date"), _ Array("Tier", "Tier"), Array("Data_Source", "Data_Source"), Array("Data_Source_Category", "Data_Source_Category"), _ Array("Jurisdiction/County", "Jurisdiction/County"), Array("Settlement_Demand", "Settlement_Demand"), Array("Jury_Verdict", "Jury_Verdict"), _ Array("Exposure_Site", "Exposure_Site"), Array("National_Defendant_Firm", "National_Defendant_Firm"), Array("Local_Defendant_Firm", "Local_Defendant_Firm"), _ Array("Expense_Amount", "Expense_Amount"), Array("NCC_Expense_Amount", "NCC_Expense_Amount"), Array("Non_NCC_Expense_Amount", "Non_NCC_Expense_Amount"))   Set wsImport = ThisWorkbook.Sheets(2) Set wsMain = ThisWorkbook.Sheets(3) Application.ScreenUpdating = False For Each e In myHeaders Set r = wsImport.Cells.Find(e(0), , , xlWhole) If Not r Is Nothing Then Set c = wsMain.Cells.Find(e(1), , , xlWhole) If Not c Is Nothing Then wsImport.Range(r.Offset(1), wsImport.Cells(Rows.Count, r.Column).End(xlUp)).Copy _ wsMain.Cells(Rows.Count, c.Column).End(xlUp)(2) Else msg = msg & vbLf & e(1) & " " & wsMain.Name End If Else msg = msg & vbLf & e(0) & " " & wsImport.Name End If Next Application.ScreenUpdating = False wsMain.Columns("A:AO").Select Selection.EntireColumn.AutoFit Application.ScreenUpdating = False Selection.ClearFormats   Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes) tbl.TableStyle = "TableStyleMedium9" Application.ScreenUpdating = True   End Sub 

Sub Standardization() Dim myHeaders, e, x, wsImport As Worksheet, wsMain As Worksheet Dim r As Range, c As Range myHeaders = Array(  Array("Account_ID", "Account_ID"), Array("Claim_ID", "Claim_ID"), Array("Account_Name", "Account_Name"), _ Array("Claim_Type", "Claim_Type"), Array("Coverage", "Coverage"), Array("Claim_Level", "Claim_Level"), Array("Claim_Count", "Claim_Count"), _ Array("File_Date", "File_Date"), Array("File_Year", "File_Year"), Array("Resolution_Date", "Resolution_Date"), _ Array("Resolution_Year", "Resolution_Year"), Array("Claim_Status", "Claim_Status"), Array("Indemnity_Paid", "Indemnity_Paid"), _ Array("Disease_Category", "Disease_Category"), Array("State_Filed", "State_Filed"), Array("First_Exposure_Date", "First_Exposure_Date"), _ Array("Last_Exposure_Date", "Last_Exposure_Date"), Array("Claimant_Employee", "Claimant_Employee"), Array("Claimant_DOB", "Claimant_DOB"), _ Array("Claimant_Deceased", "Claimant_Deceased"), Array("Claimant_DOD", "Claimant_DOD"), Array("Claimant_Diagnosis_Date", "Claimant_Diagnosis_Date"), _ Array("Product_Type", "Product_Type"), Array("Product_Line", "Product_Line"), Array("Company/Entity/PC", "Company/Entity/PC"), _ Array("Plaintiff_Law_Firm", "Plaintiff_Law_Firm"), Array("Asbestos_Type", "Asbestos_Type"), Array("Evaluation_Date", "Evaluation_Date"), _ Array("Tier", "Tier"), Array("Data_Source", "Data_Source"), Array("Data_Source_Category", "Data_Source_Category"), _ Array("Jurisdiction/County", "Jurisdiction/County"), Array("Settlement_Demand", "Settlement_Demand"), Array("Jury_Verdict", "Jury_Verdict"), _ Array("Exposure_Site", "Exposure_Site"), Array("National_Defendant_Firm", "National_Defendant_Firm"), Array("Local_Defendant_Firm", "Local_Defendant_Firm"), _ Array("Expense_Amount", "Expense_Amount"), Array("NCC_Expense_Amount", "NCC_Expense_Amount"), Array("Non_NCC_Expense_Amount", "Non_NCC_Expense_Amount")) Set wsImport = ThisWorkbook.Sheets(2) Set wsMain = ThisWorkbook.Sheets(3) Application.ScreenUpdating = False For Each e In myHeaders Set r = wsImport.Cells.Find(e(0), , , xlWhole) If Not r Is Nothing Then Set c = wsMain.Cells.Find(e(1), , , xlWhole) If Not c Is Nothing Then wsImport.Range(r.Offset(1), wsImport.Cells(Rows.Count, r.Column).End(xlUp)).Copy _ wsMain.Cells(Rows.Count, c.Column).End(xlUp)(2) Else msg = msg & vbLf & e(1) & " " & wsMain.Name End If Else msg = msg & vbLf & e(0) & " " & wsImport.Name End If Next Application.ScreenUpdating = False wsMain.Columns("A:AO").Select Selection.EntireColumn.AutoFit Application.ScreenUpdating = False Selection.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes) tbl.TableStyle = "TableStyleMedium9" Application.ScreenUpdating = True End Sub 

My code takes too long to process and if anyone could take a look at it and figure out how to make this faster, I would be grateful.

Basically, I have three sheets in my workbook where only the second and third worksheets are being used. I want to copy columns from the second sheet to the third sheet only if the column headings match. For example, the code will check the first row of sheet2 to check if it matches any of strings in an array and if it matches, it will copy the entire column to the third sheet under the same heading

Basically, I have three sheets in my workbook where only the second and third worksheets are being used. I want to copy columns from the second sheet to the third sheet only if the column headings match. For example, the code will check the first row of sheet2 to check if it matches any of strings in an array and if it matches, it will copy the entire column to the third sheet under the same heading.

This code takes too long to process and I would like to make it faster.

Basically, I have three sheets in my workbook where only the second and third worksheets are being used. I want to copy columns from the second sheet to the third sheet only if the column headings match. For example, the code will check the first row of sheet2 to check if it matches any of strings in an array and if it matches, it will copy the entire column to the third sheet under the same heading