Skip to main content
replaced http://stackoverflow.com/ with https://stackoverflow.com/
Source Link
  • You don't ever use the variable x. Get rid of it entirely.
  • You turn screen updating off three times without ever turning it back on. Once is enough.
  • Speaking of screen updating, anytime you turn it off, you need an error handler to ensure it always gets turned back on no matter what happens while the code is executing.
  • Don't activate and selectDon't activate and select. Use object references/variables instead.
  • You don't ever use the variable x. Get rid of it entirely.
  • You turn screen updating off three times without ever turning it back on. Once is enough.
  • Speaking of screen updating, anytime you turn it off, you need an error handler to ensure it always gets turned back on no matter what happens while the code is executing.
  • Don't activate and select. Use object references/variables instead.
  • You don't ever use the variable x. Get rid of it entirely.
  • You turn screen updating off three times without ever turning it back on. Once is enough.
  • Speaking of screen updating, anytime you turn it off, you need an error handler to ensure it always gets turned back on no matter what happens while the code is executing.
  • Don't activate and select. Use object references/variables instead.
removed "Edit" comments from most gracious contributor.
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177
 Dim cols As Range Set cols = wsMain.Columns("A:AO") ' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("A:AO")' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
 Dim cols As Range Set cols = wsMain.Columns("A:AO") ' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("A:AO")' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
 Dim cols As Range Set cols = wsMain.Columns("A:AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("A:AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
 Dim cols As Range Set cols = wsMain.Columns("A:AO") ' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("A:AO")' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
 Dim cols As Range Set cols = wsMain.Columns("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
 Dim cols As Range Set cols = wsMain.Columns("A:AO") ' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" 
Public Sub Standardization() On Error GoTo ExitSub 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 Next Dim cols As Range Set cols = wsMain.Columns("A:AO")' EDIT changed from ("AO") cols.EntireColumn.AutoFit cols.ClearFormats Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, cols, , xlYes) tbl.TableStyle = "TableStyleMedium9" ExitSub: Application.ScreenUpdating = True End Sub 
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177
Loading