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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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

I
  • Solved
Text to Columns VBA Optimizing
Replies
3
Views
67
MARK858
MARK858
F
  • Solved
Delimiters in VBA has different result than manual
Replies
7
Views
162
Peter_SSs
Peter_SSs
J
  • Question Question
Text to Columns in Macro
2
Replies
10
Views
831
Alex Blakenburg
A
Z
  • Solved
Date and Time Not Sorting
2
Replies
19
Views
354
MARK858
MARK858
V
  • Question Question
US/European Date Format Updates Not Working on Macro Run
Replies
0
Views
140
vancher19
V

Forum statistics

Threads
1,224,991
Messages
6,182,221
Members
453,095
Latest member
SleepyAtlasHQ

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