Simplify macro

Cloris

New Member
Joined
Oct 24, 2021
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Hi there, I am trying to increase the efficiency of the macro. Can someone help on this? Thanks in advance!
VBA Code:
Sub Macro()

'

' Macro Macro"CrossMult_Validation")

   

'
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, i As Long, j As Long
    Set WS1 = Sheets("llustration")
    Set WS2 = Sheets("CrossMult")
    Set WS3 = Sheets("Base")

   
    For j = 1 To 39
    WS3.Range("B8").Value = j
    WS3.Calculate

   
    WS2.Select
    WS2.Calculate
    Cells.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Cells.Select
    ActiveSheet.Paste

   
    ActiveSheet.Range("AU5").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Name = ActiveSheet.Range("AU5").Value

 
    For i = 1 To 43
    WS1.Range("K3").Value = i
    WS1.Calculate
    WS1.Range("G5", WS1.Range("G5").End(xlDown)).Copy
    ActiveSheet.Cells(14, i + 1).PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Calculate

 
    Next i
    Next j

End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,769
Office Version
  1. 2013
Platform
  1. Windows
Some notes:
  1. In general, it is almost never necessary to select worksheets, worksheet ranges, etc. This unnecessarily slows down the execution of your macro.
  2. Your frequent use of the Worksheet Calculate method suggests that you have set Calculation to manual. If this is not the case, it is recommended that you do so.
  3. Temporarily disabling the screen updating helps to maintain speed in your macro.
  4. Because of the explicit Calculate, I assume that the contents of column G change under the influence of the value in cell K3. If this is not the case, then those two lines Dim arr As Variant & arr = WS1.Range("G5", WS1.Range("G5").End(xlDown)).Value could/should be moved prior to the inner loop.
VBA Code:
Sub Cloris()

    ' Macro Macro"CrossMult_Validation")

    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, i As Long, j As Long
    Set WS1 = Sheets("llustration")
    Set WS2 = Sheets("CrossMult")
    Set WS3 = Sheets("Base")

    Dim xlCalc As XlCalculation, xlScrn As Boolean          ' << note #2 & #3
    xlScrn = Application.ScreenUpdating
    xlCalc = Application.Calculation

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    For j = 1 To 39

        WS3.Range("B8").Value = j

'        WS3.Calculate
'        WS2.Select
'        WS2.Calculate
'        Cells.Copy
'        Sheets.Add After:=Sheets(Sheets.Count)
'        Cells.Select
'        ActiveSheet.Paste
' >> REPLACEMENT <<
        Application.Calculate
        WS2.Copy After:=Sheets(Sheets.Count)

'        ActiveSheet.Range("AU5").Select
'        Selection.Copy
'        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'        ActiveSheet.Name = ActiveSheet.Range("AU5").Value
' >> REPLACEMENT <<
        With ActiveSheet
            .Range("AU5").Value = .Range("AU5").Value
            .Name = .Range("AU5").Value

            For i = 1 To 43
                WS1.Range("K3").Value = i
                WS1.Calculate

'                WS1.Range("G5", WS1.Range("G5").End(xlDown)).Copy
'                .Cells(14, i + 1).PasteSpecial Paste:=xlPasteValues
' >> REPLACEMENT <<
                Dim arr As Variant                                          ' << note #4
                arr = WS1.Range("G5", WS1.Range("G5").End(xlDown)).Value    ' << note #4
                .Cells(14, i + 1).Resize(UBound(arr), 1).Value = arr

                ' >> since you're pasting values rather than formulas the next Calculate seems to be superfluous <<
                ' .Calculate
            Next i
        End With
    Next j

    Application.Calculation = xlCalc
    Application.ScreenUpdating = xlScrn
End Sub
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,769
Office Version
  1. 2013
Platform
  1. Windows
Glad to help :)
 

Cloris

New Member
Joined
Oct 24, 2021
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Some notes:
  1. In general, it is almost never necessary to select worksheets, worksheet ranges, etc. This unnecessarily slows down the execution of your macro.
  2. Your frequent use of the Worksheet Calculate method suggests that you have set Calculation to manual. If this is not the case, it is recommended that you do so.
  3. Temporarily disabling the screen updating helps to maintain speed in your macro.
  4. Because of the explicit Calculate, I assume that the contents of column G change under the influence of the value in cell K3. If this is not the case, then those two lines Dim arr As Variant & arr = WS1.Range("G5", WS1.Range("G5").End(xlDown)).Value could/should be moved prior to the inner loop.
VBA Code:
Sub Cloris()

    ' Macro Macro"CrossMult_Validation")

    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, i As Long, j As Long
    Set WS1 = Sheets("llustration")
    Set WS2 = Sheets("CrossMult")
    Set WS3 = Sheets("Base")

    Dim xlCalc As XlCalculation, xlScrn As Boolean          ' << note #2 & #3
    xlScrn = Application.ScreenUpdating
    xlCalc = Application.Calculation

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    For j = 1 To 39

        WS3.Range("B8").Value = j

'        WS3.Calculate
'        WS2.Select
'        WS2.Calculate
'        Cells.Copy
'        Sheets.Add After:=Sheets(Sheets.Count)
'        Cells.Select
'        ActiveSheet.Paste
' >> REPLACEMENT <<
        Application.Calculate
        WS2.Copy After:=Sheets(Sheets.Count)

'        ActiveSheet.Range("AU5").Select
'        Selection.Copy
'        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'        ActiveSheet.Name = ActiveSheet.Range("AU5").Value
' >> REPLACEMENT <<
        With ActiveSheet
            .Range("AU5").Value = .Range("AU5").Value
            .Name = .Range("AU5").Value

            For i = 1 To 43
                WS1.Range("K3").Value = i
                WS1.Calculate

'                WS1.Range("G5", WS1.Range("G5").End(xlDown)).Copy
'                .Cells(14, i + 1).PasteSpecial Paste:=xlPasteValues
' >> REPLACEMENT <<
                Dim arr As Variant                                          ' << note #4
                arr = WS1.Range("G5", WS1.Range("G5").End(xlDown)).Value    ' << note #4
                .Cells(14, i + 1).Resize(UBound(arr), 1).Value = arr

                ' >> since you're pasting values rather than formulas the next Calculate seems to be superfluous <<
                ' .Calculate
            Next i
        End With
    Next j

    Application.Calculation = xlCalc
    Application.ScreenUpdating = xlScrn
End Sub
Hi, can i know instead of hardcode the number of product, for example : "j =1 To 39", is there any suggestion that I can make it to let the user to fill in how many products in this vba coding?

**j is product
**i is variable


May i know can the coding change to " For i = 1 To k, then I can put k as any integer in spreadsheet?
Thanks in advance :)
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,769
Office Version
  1. 2013
Platform
  1. Windows
You can indeed place the number of products in a cell and let the number of times that the outer loop is run depend on that number.
Obtaining a value from a cell and assigning to a VBA variable can be coded like:
VBA Code:
Dim ProductCount as Long
ProductCount = Range("A1").Value    ' <<< change cell to suit
and the line that reads For j = 1 to 39 can be changed like
VBA Code:
For j = 1 to ProductCount

Of course, the same applies for the inner loop.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,846
Messages
5,833,937
Members
430,247
Latest member
w9u5280o

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
Top