HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Conditionally copy columns

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
conditionallycolumnscopy

Problem

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 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:

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 Worksheet


Is 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 Worksheet


My 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 With


See 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 ws


The 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 Worksheet
Dim wsImport As Worksheet
Dim wsMain As Worksheet
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 With

Context

StackExchange Code Review Q#92663, answer score: 8

Revisions (0)

No revisions yet.