Simplify macro

[Cloris]

Hi there, I am trying to increase the efficiency of the macro. Can someone help on this? Thanks in advance!

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

 

[GWteB]

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.

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

 

[Cloris]

Thanks alot !

 

[GWteB]

Glad to help

 

[Cloris]

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.

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]

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:

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

For j = 1 to ProductCount

Of course, the same applies for the inner loop.