patternMinor
Conditionally copy columns
Viewed 0 times
conditionallycolumnscopy
Problem
I have this Excel/VBA code and here is what it does:
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 Explicit
Private 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
- 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 Explicit
Private 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
Solution
Your code has tremendously improved since the first time I saw it - good job!
This particular line is hard to parse:
Literally: it's crashing the rubberduck parser!
You could introduce a local variable here:
Notice how the line continuation is placed so that no instruction is split; rubberduck doesn't care about line continuations, but it's much easier for the human eye to see what function calls return the arguments for which procedure if you don't split an instruction between the name of a procedure and its arguments - vertically lining up
Is this really buying you anything? Multiple declarations on a single line make it harder to locate declarations at a glance. Compare to:
My eye sees
There's a redundant reference to
See it? Right here:
Could be
The extraneous empty lines before
Your indentation isn't consistent.
The only thing that should be at the same indentation level as
This particular line is hard to parse:
wsImport.Range(source.Offset(1), wsImport.Cells(Rows.Count, source.Column).End(xlUp)).Copy _
wsMain.Cells(Rows.Count, dest.Column).End(xlUp)(2)Literally: it's crashing the rubberduck parser!
You could introduce a local variable here:
Dim target As Range
Set target = wsMain.Cells(Rows.Count, dest.Column).End(xlUp)
wsImport.Range(source.Offset(1), wsImport.Cells(Rows.Count, source.Column).End(xlUp)) _
.Copy target(RowIndex:=2)Notice how the line continuation is placed so that no instruction is split; rubberduck doesn't care about line continuations, but it's much easier for the human eye to see what function calls return the arguments for which procedure if you don't split an instruction between the name of a procedure and its arguments - vertically lining up
.Range and .Copy also make it clearer that .Copy operates on the result of .Range.Dim wsImport As Worksheet, wsMain As WorksheetIs this really buying you anything? Multiple declarations on a single line make it harder to locate declarations at a glance. Compare to:
Dim wsImport As Worksheet
Dim wsMain As WorksheetMy eye sees
Dim, my brain sees "variable declaration here" - two Dims, two variables. And I read the variable name at pretty much the exact same millisecond as the one I notice the Dim statement, because I don't need to mentally scroll horizontally and locate the comma. Two variables isn't too bad, but more than that would be problematic. Better avoid multiple declarations on a single line.There's a redundant reference to
wsMain in this With block:With 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 WithSee it? Right here:
.Cells.Resize(wsMain.Rows.Count - 1).Offset(1).Interior.Color = RGB(216, 228, 188)Could be
.Cells.Resize(.Rows.Count - 1).Offset(1).Interior.Color = RGB(216, 228, 188)The extraneous empty lines before
End With should be removed, too.Your indentation isn't consistent.
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
ActiveWindow.Zoom = 85
Next wsThe only thing that should be at the same indentation level as
Public Sub/End Sub, is line labels (which the VBE forces to start at column 1 anyway).Code Snippets
wsImport.Range(source.Offset(1), wsImport.Cells(Rows.Count, source.Column).End(xlUp)).Copy _
wsMain.Cells(Rows.Count, dest.Column).End(xlUp)(2)Dim target As Range
Set target = wsMain.Cells(Rows.Count, dest.Column).End(xlUp)
wsImport.Range(source.Offset(1), wsImport.Cells(Rows.Count, source.Column).End(xlUp)) _
.Copy target(RowIndex:=2)Dim wsImport As Worksheet, wsMain As WorksheetDim wsImport As Worksheet
Dim wsMain As WorksheetWith 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 WithContext
StackExchange Code Review Q#92663, answer score: 8
Revisions (0)
No revisions yet.