VBA optimization advice

D

DragonPrinces

New Member
Joined
Apr 30, 2013
Messages
32
Hi, I have been working on an automation macro but i have basically spliced this together from all over the place and wanted to ask if anyone here can guide me as to how to make it more efficient, remove unneeded steps etc.

The basic idea with this macro is in columns O and P i am pulling data from another sheet if C meets certain criteria. then in D E G J i am able to populate these based on if C meets a criteria and I4 is a specific variable.
I am then using the macro to copy paste all these formulas to the respective columns ther recopy pate as values then because the "" in my IFs are not real blanks (i need true empty cells for another checking formula) i use a combination of TextToColumn (if there is something in the column) and ClearContents to truly empty the cells.

so yea i am just kinda trying to learn from someone more knowledgeable as to how i may have done either all of this better or individual bits better.

Table Image of for reference
MrExcel1.png


VBA Code: 
Sub FleetTrip()

    If MsgBox("Click OK to run macro (Populate from TGO)", _
        vbOKCancel + vbQuestion) = vbCancel Then Exit Sub
    
    Application.ScreenUpdating = False
    
' Driver and reason formula + copy paste

    Range("O10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Fleet"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Reason for " & _
        "travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19))),"""")" & _
        ""
        
    Range("P10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Vehicle start"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Rea" & _
        "son for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C17:R9415C17))),"""")" & _
        ""
    Range("O10:P10").Select
    Selection.Copy
    Range("O10:P40").Select
    ActiveSheet.Paste
    
    Range("O10:P40").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' GBV "x" formula + copy paste
    Range("D10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=R9C4),""x"",""""),"""")"
    Range("D10").Select
    Selection.Copy
    Range("D10:D40").Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' Anglo "x" formula + copy paste
    Range("E10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=R9C5),""x"",""""),"""")"
    Range("E10").Select
    Selection.Copy
    Range("E10:E40").Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' SOBC "x" formula + copy paste
    Range("J10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=""SOBC""),""x"",""""),"""")"
    Range("J10").Select
    Selection.Copy
    Range("J10:J40").Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' TRA "x" formula + copy paste
    Range("G10").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0,[@Driver]=""Fleet""),""x"",""""),"""")"
    Range("G11").Select
    Range("G10").Select
    Selection.Copy
    Range("G10:G40").Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' All columns convert to general

    'On Error Resume Next
    
    Range("O10:O40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("O10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
        
    Range("P10:P40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("P10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
    
    Range("D10:D40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("D10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
        
    Range("E10:E40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("E10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
        
    Range("G10:G40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("G10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
        
    Range("J10:J40").Select
    If Application.WorksheetFunction.CountBlank(Selection) = 31 Then
    Selection.ClearContents
    Else
    Selection.TextToColumns Destination:=Range("J10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    End If
    
    'On Error GoTo 0
    Application.CutCopyMode = False
    Range("B10").Select
    Application.ScreenUpdating = True
    MsgBox ("Done")
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
in terms of code optimisation, here's what the first section of your code can look like:
VBA Code: 
Sub FleetTrip()

    If MsgBox("Click OK to run macro (Populate from TGO)", _
        vbOKCancel + vbQuestion) = vbCancel Then Exit Sub
   
    Application.ScreenUpdating = False
   
' Driver and reason formula + copy paste

    Range("O10:O40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Fleet"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Reason for " & _
        "travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19))),"""")"
       
    Range("P10:P40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Vehicle start"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Rea" & _
        "son for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C17:R9415C17))),"""")"
   
    With Range("O10:P40")
        .Value = .Value
    End With
'...
e.g. 3 operations instead of 11.
Simply removing all SELECT statements where not needed is a huge optimisation alone.
 
Upvote 0
bobsan42 said:
e.g. 3 operations instead of 11.
Simply removing all SELECT statements where not needed is a huge optimisation alone.
Click to expand...
Wow.... This was kinda of amazing
with this principle in mind i got the original code from 149 lines down to 50 AND it runs in 1/4 the time
Thank you so much

So for if i am understanding things correct here
What i was doing with the macro was having it simulate a click n drag with the select Select statements correct? Where what you showed me using Range(). is simply settings those cells to that value rather than having to simulate a fill in and copy paste actions?

The thing i don't quiet understand is the With statement and what magic it is performing?

and finally if i understand correct here the .Value=.Value is performing the same function as a copy paste(values) would do right? but rather than actually running the copy paste value functions we are simply saying take the value of the cell(containing formula while showing the answer) and setting it to the formula answer (similar to paste value)

Thank you again
Here is what it looks like now :)
VBA Code: 
Sub FleetTrip()

    If MsgBox("Click OK to run macro (Populate from TGO)", _
        vbOKCancel + vbQuestion) = vbCancel Then Exit Sub
    
    Application.ScreenUpdating = False
    
' Driver and reason formula + copy paste

    Range("O10:O40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Fleet"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Reason for " & _
        "travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19))),"""")" & _
        ""
        
    Range("P10:P40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0),""Vehicle start"",IF(AND(OR(R4C9=""usaid gbv"",R4C9=""anglo"",R4C9=""sobc""),IFERROR(XLOOKUP(R3C3&""|15 - Reason for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C19:R9415C19),""blank"")=""blank"",[@Activity]>1,OR([@[USAID GBV]]=""x"",[@ANGLO]=""x"",[@SIB]=""x"")),""No Info"",XLOOKUP(R3C3&""|15 - Rea" & _
        "son for travel|""&[@[Days of month]],'Raw KMs'!R2C20:R9415C20,'Raw KMs'!R2C17:R9415C17))),"""")" & _
        ""
    
    With Range("O10:P40")
        .Value = .Value
    End With
    
' GBV "x" formula + copy paste
    Range("D10:D40")FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=R9C4),""x"",""""),"""")"
    
' Anglo "x" formula + copy paste
    Range("E10:E40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=R9C5),""x"",""""),"""")"
    
' SOBC "x" formula + copy paste
    Range("J10:J40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]>1,R4C9=""SOBC""),""x"",""""),"""")"
    
' TRA "x" formula + copy paste
    Range("G10:G40").FormulaR1C1 = _
        "=IFERROR(IF(AND([@Activity]<=1,[@Activity]>0,[@Driver]=""Fleet""),""x"",""""),"""")"
    
' All columns convert to general
    
    With Range("D10:K40")
        .Value = .Value
    End With

    Application.CutCopyMode = False
    Range("B10").Select
    Application.ScreenUpdating = True
    MsgBox ("Done")
End Sub
 
Upvote 0
Yes, to everything.
The With block is not particularly useful in this case, but it replaces this:
VBA Code: 
Range("O10:P40").Value = Range("O10:P40").Value
Sometimes disabling automatic calculations can bring a huge performance improvement, but you must use it carefully..
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
204
John_w
J
A
  • Solved
Looping Through Columns
Replies
3
Views
517
kevin9999
K
Q
  • Question
How to remove 400 error from clear even rows/text to columns macro?
Replies
1
Views
160
Joe4
Joe4
I
  • Solved
Moving Data based off a condition
Replies
7
Views
168
ItalianPlatinum
I
V
  • Solved
Test to column not working.
Replies
3
Views
411
MARK858
MARK858

Forum statistics

Threads
1,215,212
Messages
6,123,649
Members
449,111
Latest member
ghennedy

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top