Optimizing VBA code

VytautasM

New Member
Joined
Jan 31, 2020
Messages
33
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
Good day All,

Have a fairly beefy VBA Worksheet_change code. Have copied just a snippet, but the rest of the code has the same structure. It runs fine, but would like it to be more streamlined. Was wondering is there any way of optimizing, changing it to run faster, more smooth. Is it possible to change the Range to an Array and would it make a difference? Any suggestions are welcome.

Thank you.

VBA Code:
If Not Application.Intersect(Target, Range("A8:A3009")) Is Nothing Then
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.PrintCommunication = False
Application.DisplayAlerts = False
        For Each c In Target
            If Not IsEmpty(c.Value) Then
                Range("D" & c.Row).Value = "D"
                Range("B" & c.Row).Font.ColorIndex = 15
                Range("B" & c.Row).Value = "A"
                Range("C" & c.Row).Value = ""
                Range("M" & c.Row).FormulaArray = "=IFERROR(IF(COUNTIF(R[1]C:INDEX(R[1]C:R3010C13,MATCH(TRUE,(R[1]C[-11]:R3010C2=""A""),0)-1),""*""&""EXPRESS""&""*""),""Ir IKI EXPRESS"",""""),"""")"
                Range("AJ" & c.Row).Value = ""
                Range("AK" & c.Row).Value = ""
                Range("AL" & c.Row).Value = ""
                Range("AN" & c.Row).Value = ""
                Range("AT" & c.Row).Value = ""
                Range("AU" & c.Row).Value = ""
                Range("AI" & c.Row).Value = ""
                Range("AV" & c.Row).Value = ""
                Range("W" & c.Row).Value = ""
                Range("L" & c.Row).Value = ""
                Range("AY" & c.Row).Value = ""
                Range("AY" & c.Row).NumberFormat = "@"
                Range("AH" & c.Row).Value = ""
                Range("AO" & c.Row).Value = ""
                Range("AW" & c.Row).FormulaArray = "=IFERROR(IF(AND(EXACT(R[1]C:INDEX(R[1]C:R3010C,MATCH(TRUE,(R[1]C[-47]:R3010C2=""A""),0)-1),""aaa"")),""AAA"",""""),"""")"
                Range("E" & c.Row).FormulaArray = "=IFERROR(SUM(R[1]C[31]:INDEX(R[1]C[31]:R3010C36,MATCH(TRUE,(R[1]C[-3]:R3010C2=""A""),0))),"""")"
                Range("E" & c.Row).NumberFormat = "#.00 €"
                Range("F" & c.Row).FormulaArray = "=IFERROR(SUM(R[1]C[29]:INDEX(R[1]C[29]:R3010C35,MATCH(TRUE,(R[1]C[-4]:R3010C2=""A""),0))),"""") & "" VNT./KG"""
                Range("G" & c.Row).FormulaArray = "=IFERROR(SUM(R[1]C[31]:INDEX(R[1]C[31]:R3010C38,MATCH(TRUE,(R[1]C[-5]:R3010C2=""A""),0))),"""")"
                Range("G" & c.Row).NumberFormat = "#.00 €"
                c.EntireRow.Locked = True
                Range("a" & c.Row).Locked = False
                Range("d" & c.Row).Locked = False
                Range("r" & c.Row).Locked = False
                Range("v" & c.Row).Locked = False
                Range("ae" & c.Row).Locked = False
                Range("ay" & c.Row).Locked = False
                Range("a" & c.Row & ":BA" & c.Row).Interior.ColorIndex = 15
                Range("a" & c.Row & ":BA" & c.Row).Font.Bold = True
                Range("a" & c.Row & ":BA" & c.Row).Font.Size = 10
            Else 'Jei eiles numeris istrinimas
                Range("a" & c.Row & ":BA" & c.Row).Font.Size = 8
                Range("a" & c.Row & ":BA" & c.Row).Font.Bold = False
                Range("a" & c.Row & ":BA" & c.Row).ClearComments
                Range("A" & c.Row & ":BA" & c.Row).Interior.ColorIndex = 0
                Range("B" & c.Row).Font.ColorIndex = 1
                Range("B" & c.Row).Value = ""
                Range("D" & c.Row).Value = "=IFERROR(VLOOKUP(RC[-1],Asortment!C[-2]:C[17],4,0),"""")"
                Range("C" & c.Row).Value = ""
                Range("F" & c.Row).Value = "=IFERROR(INDEX(Validation!R2C10:R699C10,MATCH(INDEX(Asortment!C[14],MATCH(RC[-3],Asortment!C[-4],0)),Validation!R2C9:R699C9,0)),"""")"
                Range("G" & c.Row).Value = ""
                Range("G" & c.Row).NumberFormat = "General"
                Range("R" & c.Row).Value = ""
                Range("L" & c.Row).Value = "=IF(COUNTIF(Validation!R1C20:R7C20,RC[39])>0,""A1 level"",IF(RC[-1]<70,""A level"",""""))"
                Range("V" & c.Row).Value = ""
                Range("AW" & c.Row).Value = "=IFERROR(VLOOKUP(RC[-46],Asortment!C[-47]:C[-26],21,0),"""")"
                Range("E" & c.Row).Value = "=IFERROR(VLOOKUP(RC[-2],Asortment!C[-3]:C[15],3,0),"""")"
                Range("E" & c.Row).NumberFormat = "General"
                Range("AJ" & c.Row).Value = "=IFERROR(RC[-14]/1.21*RC[-1],"""")"
                Range("AK" & c.Row).Value = "=RC[-15]/1.21-RC[-13]"
                Range("AL" & c.Row).Value = "=IFERROR(RC[-3]*RC[-1],"""")"
                Range("AU" & c.Row).Value = "=IFERROR(RC[-12]*RC[-10],"""")"
                Range("M" & c.Row).Value = "=IF(RC[-3]>17,""EXPRESS"","""")"
                Range("Q" & c.Row).Interior.ColorIndex = 36
                Range("S" & c.Row).Value = "=IFERROR(VLOOKUP(RC[-16],Asortment!C[-17]:C[1],5,0),"""")"
                Range("U" & c.Row).Interior.Color = RGB(255, 204, 204)
                Range("W" & c.Row).Value = "=IFERROR((RC[-1]/1.21-RC[1])/(RC[-1]/1.21),"""")"
                Range("W" & c.Row).Interior.ColorIndex = 35
                Range("Z" & c.Row).Interior.ColorIndex = 35
                Range("AD" & c.Row).Interior.ColorIndex = 35
                Range("AE" & c.Row).Value = ""
                Range("AE" & c.Row).Interior.ColorIndex = 35
                Range("AF" & c.Row).Interior.ColorIndex = 35
                Range("AG" & c.Row).Interior.ColorIndex = 35
                Range("AH" & c.Row).Value = "=IFERROR(((RC[-12]/1.21-RC[-10])/(RC[-12]/1.21)*100),"""")"
                Range("AH" & c.Row).Interior.ColorIndex = 35
                Range("AN" & c.Row).Value = "=IFERROR((((RC[-18]/1.21)-(RC[-16]*(1-RC[-1])))*RC[-5]),"""")"
                Range("AO" & c.Row).Value = "=IFERROR(((RC[-19]/1.21-(RC[-17]*(1-RC[-2])))/(RC[-19]/1.21)),"""")"
                Range("AT" & c.Row).Value = "=IF(RC[-1]=""KG"",RC[-24]/RC[-2],IF(RC[-1]=""LT"",RC[-24]/RC[-2],IF(RC[-1]=""GR"",RC[-24]*1000/RC[-2],IF(RC[-1]=""ML"",RC[-24]*1000/RC[-2],IF(RC[-1]=""ST"",RC[-24]/RC[-2])))))"
                Range("AY" & c.Row).Value = "=IFERROR(VLOOKUP(RC[-48],Asortment!C[-49]:C[-31],19,0),"""")"
                Range("AY" & c.Row).NumberFormat = "General"
                c.EntireRow.Locked = True
                Range("a" & c.Row).Locked = False
                Range("b" & c.Row).Locked = False
                Range("c" & c.Row).Locked = False
            End If
        Next c
    End If

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.PrintCommunication = True
Application.DisplayAlerts = True
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
A few options.

1. First for legibility sake I would group everything by columns Left to Right. For instance, rewrite this as B, then C, then D at least when possible.

VBA Code:
                Range("D" & c.Row).Value = "D"
                Range("B" & c.Row).Font.ColorIndex = 15
                Range("B" & c.Row).Value = "A"
                Range("C" & c.Row).Value = ""

2. You can consolidate grouped ranges that are doing the same thing. Change

VBA Code:
                Range("AJ" & c.Row).Value = ""
                Range("AK" & c.Row).Value = ""
                Range("AL" & c.Row).Value = ""

to

VBA Code:
Range(Range("AJ" & c.Row), Range("AL" & c.Row)).Value = ""

3. Group like columns. I prefer writing out formulas in Relative/Absolute code in the first row and then copy and paste them down. Depending on how your workbook is set up you can have 2 dummy rows one for when the If Not IsEmpty(c.Value) Then condition is met and one where it's not then you can copy each range and paste it. Then you can eliminate almost all of the code and replace it with something like

VBA Code:
If Not IsEmpty(c.Value) Then
    Range(DummyRange1).Copy
    Range("A" & c.Row).Paste
Else 'Jei eiles numeris istrinimas
    Range(DummyRange2).Copy
    Range("A" & c.Row).Paste
End If
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

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