Search code examples
excelvbaexcel-formulaselect-case

Shorten case select [formula populating] code because procedure is too large


I've made a sub which has become too large due to my select case, which is from 1 to 16.

For select case 1

  • cells on line 2 get a formula filled in (sheet3)
  • lines are hidden from 32 down (sheet3)

For select case 2

  • cells on line 32 gets the same formula, but the reference cells is 1 down from select case 1 (sheet3)
  • lines are hidden 62 down (sheet3)
  • cells are autofilled 2 down(sheet2)

For select case 3

  • cells on line 62 gets the same formula, but the reference cells is 1 down from select case 1 (sheet3)
  • lines are hidden 92 down (sheet3)
  • cells are autofilled 3 down(sheet2)

etc.

Can I shorten my code by writing the formula in a different way or can I put part of my select case in a different sub? (full code (case 1-3) pasted below in case I'm not clear enough)

The formula's:

Set rnga = Range("a2")
Set rngh = Range("h2")
Set rngb = Range("b2")
Set rngi = Range("I2")
Set rngd = Range("d2")
Set rnge = Range("e2")
Set rngc = Range("c2")

Set rnga3 = Sheets("Artikelen_in_stuklijsten").Range("a2")
Set rngh3 = Sheets("Artikelen_in_stuklijsten").Range("h2")
Set rngb3 = Sheets("Artikelen_in_stuklijsten").Range("b2")
Set rngi3 = Sheets("Artikelen_in_stuklijsten").Range("I2")
Set rnge3 = Sheets("Artikelen_in_stuklijsten").Range("e2")
Set rngc3 = Sheets("Artikelen_in_stuklijsten").Range("c2")

Set rnga4 = Sheets("Stuklijsten_aanmaken").Range("a2")
Set rngb4 = Sheets("Stuklijsten_aanmaken").Range("b2")
Set rngcd4 = Sheets("Stuklijsten_aanmaken").Range("c2:d2")
Set rngeg4 = Sheets("Stuklijsten_aanmaken").Range("e2:g2")

                  'the 500 becomes 500 + 1     [or 500 + samenstelling_aantal -1]  
                  With Sheets("Artikelen_aanmaken")
                        rnga.Formula = ("=N$500&""_POS ""&referentie!C1&K2")
                        rngh.Formula = (rnga.Formula)
                        rngb.Formula = ("=R$500&""_POS ""&referentie!C1&K2")
                        rngi.Formula = (rngb.Formula)
                        rngd.Formula = ("=N$500&P$500")
                        rnge.Formula = (rngd.Formula)
                        rngc.Value = ("6")
                    End With

                    Sheets("Artikelen_in_stuklijsten").Activate
                        rnga3.Formula = ("=Artikelen_aanmaken!Q$500& Artikelen_aanmaken!N$500")
                        rngh3.Formula = ("0")
                        rngb3.Formula = ("=Artikelen_aanmaken!N$500&""_POS ""&referentie!C1")
                        rngi3.Formula = ("1")
                        rnge3.Formula = ("=referentie!D1")                                              
                        rngc3.Value = ("=Stuklijsten_aanmaken!D$2&""_POS ""&referentie!C1")  'becomes D2+1

Plutian's help code:

Public Sub aantal_samenstellingen()

Dim samenstelling_aantal As String
Dim loopinstance As Integer

    Sheets("Artikelen_aanmaken").Activate

    samenstelling_aantal = InputBox("Hoeveel nieuwe samenstellingen zijn er? (MAX. 16 invoeren)")

       Range(2 + samenstelling_aantal * 30 & ":498").EntireRow.Hidden = True 'hides from row 3 + 30 times your number. So 33 for case 1, 63 for case 2 etc.


        For loopinstance = 500 To 500 + samenstelling_aantal - 1 'the -1 is since this loop needs to start from 0 when the instance is 1.


                With Sheets("Artikelen_aanmaken")
                    .Range("A" & 2 + loopinstance * 30).Formula = ("=N$" & loopinstance & "&""_POS ""&referentie!C1&K2") 'copies from range A and 2 + 30 times the instance. Either 30 times 0 = 0 or 30 times 1 is 30 etc.
                    .Range("H" & 2 + loopinstance * 30).Formula = (Range("A" & 2 + loopinstance * 30).Formula)
                    .Range("B" & 2 + loopinstance * 30).Formula = ("=R$" & loopinstance & "&""_POS ""&referentie!C1&K2") 'R&50" & loopinstance takes the loop instance number and pastes it to the end (so 500 for instance 1, 501 for the second etc.)
                    .Range("I" & 2 + loopinstance * 30).Formula = (Range("B" & 2 + loopinstance * 30).Formula)
                    .Range("D" & 2 + loopinstance * 30).Formula = ("=N$" & loopinstance & "&P$" & loopinstance)
                    .Range("E" & 2 + loopinstance * 30).Formula = (Range("D" & 2 + 30 * loopinstance).Formula)
                    .Range("C" & 2 + loopinstance * 30).Value = ("6")
                End With

                With Sheets("Artikelen_in_stuklijsten")
                    .Range("A" & 2 + loopinstance * 30).Formula = ("=Artikelen_aanmaken!Q$" & loopinstance & "& Artikelen_aanmaken!N$" & loopinstance)
                    .Range("H" & 2 + loopinstance * 30).Formula = ("0")
                    .Range("B" & 2 + loopinstance * 30).Formula = ("=Artikelen_aanmaken!N$" & loopinstance & "&""_POS ""&referentie!C1")
                    .Range("I" & 2 + loopinstance * 30).Formula = ("1")
                    .Range("E" & 2 + loopinstance * 30).Formula = ("=referentie!D1")
                   'I'm changing something in this code line
                   'new .Range("C" & 2 + loopinstance * 30).Value = (Sheets("Stuklijsten_aanmaken").Range("=D$" & loopinstance & "&""_POS ""&referentie!C1"))
                   'old .Range("C" & 2 + loopinstance * 30).Value = ("=Stuklijsten_aanmaken!D$2&""_POS ""&referentie!C1")

                    .Range("D" & 2 + loopinstance * 30).Value = ("1")
                End With


        Next loopinstance

    If samenstelling_aantal = "1" Then
                Exit Sub
            Else:
        With Sheets("Stuklijsten_aanmaken") 'this is outside the loop as it only needs to be called once. This takes the Samenstelling_aantal as the resize option.
            .Range("A2").AutoFill Destination:=.Range("A2").Resize(samenstelling_aantal), Type:=xlFillDefault
            .Range("B2").AutoFill Destination:=.Range("B2").Resize(samenstelling_aantal), Type:=xlFillCopy
            .Range("C2:D2").AutoFill Destination:=.Range("C2:D2").Resize(samenstelling_aantal), Type:=xlFillDefault
            .Range("E2:G2").AutoFill Destination:=.Range("E2:G2").Resize(samenstelling_aantal), Type:=xlFillCopy
        End With

    End If

End Sub

Solution

  • If I understand correctly, each case select is a repetition of the previous case select actions, plus the one for this case. This for one can be done easily with a loop instead, already cutting each case down to one block of code.

    Secondly when this is replaced with a loop, each loop is identical, the only thing changing is the amount of times it is called. So instead of repeating it, you could just call the loop with passing your case select number as an instance number instead. This is exactly what I have done below:

    Sub caseselectreplacement()
    Dim samenstelling_aantal As Integer
    
        Range(3 + samenstelling_aantal * 30 & ":498").EntireRow.Hidden = True 'hides from row 3 + 30 times your number. So 33 for case 1, 63 for case 2 etc.
    
    samenstelling_aantal = 2 'Fake number for testing purposes
    
    Dim loopinstance As Integer
    
    For loopinstance = 0 To samenstelling_aantal - 1 'the -1 is since this loop needs to start from 0 when the instance is 1.
        With Sheets("Artikelen_aanmaken")
            .Range("A" & 2 + loopinstance * 30).Formula = ("=N$50" & loopinstance & "&""_POS ""&referentie!C1&K2") 'copies from range A and 2 + 30 times the instance. Either 30 times 0 = 0 or 30 times 1 is 30 etc.
            .Range("H" & 2 + loopinstance * 30).Formula = (Range("A2").Formula)
            .Range("B" & 2 + loopinstance * 30).Formula = ("=R$50" & loopinstance & "&""_POS ""&referentie!C1&K2") 'R&50" & loopinstance takes the loop instance number and pastes it to the end (so 500 for instance 1, 501 for the second etc.)
            .Range("I" & 2 + loopinstance * 30).Formula = (Range("B2").Formula)
            .Range("D" & 2 + loopinstance * 30).Formula = ("=N$50" & loopinstance & "&P$50" & loopinstance)
            .Range("E" & 2 + loopinstance * 30).Formula = (Range("D" & 2 + 30 * loopinstance).Formula)
            .Range("C" & 2 + loopinstance * 30).Value = ("6")
        End With
    
        With Sheets("Artikelen_in_stuklijsten")
            .Range("A" & 2 + loopinstance * 30).Formula = ("=Artikelen_aanmaken!Q$50" & loopinstance & "& Artikelen_aanmaken!N$50" & loopinstance)
            .Range("H" & 2 + loopinstance * 30).Formula = ("0")
            .Range("B" & 2 + loopinstance * 30).Formula = ("=Artikelen_aanmaken!N$50" & loopinstance & "&""_POS ""&referentie!C1")
            .Range("I" & 2 + loopinstance * 30).Formula = ("1")
            .Range("E" & 2 + loopinstance * 30).Formula = ("=referentie!D1")
            .Range("C" & 2 + loopinstance * 30).Value = ("=Stuklijsten_aanmaken!D$2&""_POS ""&referentie!C1")
        End With
    Next loopinstance
    
    With Sheets("Stuklijsten_aanmaken") 'this is outside the loop as it only needs to be called once. This takes the Samenstelling_aantal as the resize option.
        .Range("A2").AutoFill Destination:=.Range("A2").Resize(samenstelling_aantal), Type:=xlFillDefault
        .Range("B2").AutoFill Destination:=.Range("B2").Resize(samenstelling_aantal), Type:=xlFillDefault
        .Range("C2:D2").AutoFill Destination:=.Range("C2:D2").Resize(samenstelling_aantal), Type:=xlFillDefault
        .Range("E2:G2").AutoFill Destination:=.Range("E2:G2").Resize(samenstelling_aantal), Type:=xlFillCopy
    End With
    End Sub
    

    Please note, it runs perfectly for me, but I have no access to your data so I can't check if everything gets pulled correctly. Please backup your data first before testing because it might have some slightly unexpected results.