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

Question

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

Where do you define your `rnga` and `rngb` etc. ranges? Depending on how these positions are determined, you could possibly derive these through calculations and pass all differences through a `function` instead, meaning you could condense every repeated block into one. — Plutian, Nov 25 '19 at 08:47
Can I also ask from which sheet you call this from? You set a `Range("a2")` which is by default on the current sheet, but I can't link that to a sheet name with the code provided. — Plutian, Nov 25 '19 at 09:08
all the ranges that don't have a sheet name are referrring to `"artikelen aanmaken"` (sheet1) — Renate, Nov 25 '19 at 09:45

Plutian · Accepted Answer · 2019-11-25T10:31:38.810

0

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.

edited Nov 25 '19 at 10:31

answered Nov 25 '19 at 10:26

Plutian

2,276
3
14
23

Thank you soo much! you just made my code go from 1200 lines to about 30. I might try to use the loop for my other `sub`s too. The only change I had to make was the line `.Range("H" & 2 + loopinstance * 30).Formula = (Range("A2").Formula)` to include the loop too. Again thank you so much – Renate Nov 25 '19 at 12:49
Happy to help. I'm honestly glad to hear it works because I wasn't too convinced I accounted for all changes. Any more trouble let me know! – Plutian Nov 25 '19 at 13:10
Hey, I just had someone else work in the document and we found something. Once the `loopinstance` goes above `9`, the formula starts referring to `5010` `5011` etc while it should be `510` `511` etc. Maybe we can solve that with an `if` statement for `samenstelling aantal = 10, ..., 16` where it becomes `"=R$5" &` – Renate Nov 28 '19 at 08:56
That is a very interesting problem I should have anticipated. It is probably easily solved though like so: change `"=N$50" & loopinstance & "&""_POS` (which adds the number to the end of `50` to `"=N$" & 500 + loopinstance & "&""_POS`. I've not tested this, but it should work by adding 500 to your loopinstance and giving you the correct result. – Plutian Nov 28 '19 at 09:04
Ah that is a way easier solution yeah, and at least now we both have another learning experience. I tested it and that is now fixed, thank you :) (spoke too soon...) – Renate Nov 28 '19 at 09:09
You're welcome. It's a bit embarrassing as I should've done it that way to begin with, but at least it works now! – Plutian Nov 28 '19 at 09:11
Edited my previous comment but was too late, It briefly (half) worked I think but now it won't even put the formula in the cells. The new code is: `For loopinstance = 500 To 500 + samenstelling_aantal - 1 ` and then I removed the `50`s from the forumula's. I can post the code if that helps but I honestly don't understand why thats not working. (Edit: the issue is with the 500 and nothing after the column letter because it works with the old layout) – Renate Nov 28 '19 at 09:21
Yes, please post your code. I've tested a few things and this solution should work. – Plutian Nov 28 '19 at 09:32
It's in the original post at the bottom – Renate Nov 28 '19 at 09:35
Ah I spotted the error. If loopinstance is 1, then the loop would be from 500 to 500. Which means the target is reached and the loop isn't executed, it will then end the sub and not paste the formula in the cell as required. – Plutian Nov 28 '19 at 09:36
But that would be the same for the other definition right? Or is it taking the loop as `For loopinstance = 500 To 500 (+ samenstelling_aantal - 1)` instead of `For loopinstance = 500 To (500 + samenstelling_aantal - 1)` – Renate Nov 28 '19 at 09:44
You are correct, I forgot to set the "samenstelling_aantal" which is 0 by default, evaluating to `0+500-1=499` instead. Apologies. I have found the error though, the issue is that you use loopinstance twice in your formula, both to determine the range to paste to and the formula. So when using `.Range("A" & 2 + loopinstance * 30).Formula = ("=N$" & loopinstance & "&""_POS ""&referentie!C1&K2")` the formula posted is correct. However it will be posted in `Range("A" & 2 + 500 *30")` meaning it will likely end up in `A15002` Therefore it will be best to not change the loop instance number. – Plutian Nov 28 '19 at 09:56
oh yeah you're right, I could've noticed that my scroll bar was smaller.. Back to the `if, else` statement it is I guess, I'm going to try that out. – Renate Nov 28 '19 at 10:01
Alright, got it working with a select case because less typing of these `"`. Now I''m gonna work on that line that I commented out. Thank you again for your help, I'm really starting to enjoy vba even though it's driving me crazy – Renate Nov 28 '19 at 10:11
*I'm really starting to enjoy vba even though it's driving me crazy* - be careful, this is how I started out, and it's a very slippery slope ;) – Plutian Nov 28 '19 at 10:18

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

1 Answers1