Pick out excel cells from a long horizontal list based on an adjacent numerical value

Question

I've already written this macro that does exactly what I want it to do. However, it's quite large, and I may wish to expand on it in future. Basically, the purpose is to copy and paste items from a horizontal list (where RNG is equal to the number of items there), and take one cell from each. Any suggestions in cutting this down? It feels as if there should be a way, since so little changes from line to line.

Sub Test()
Dim Rng As Range
Dim i As Long
i = 3
While i <= 300
 Set Rng = Range("J" & i)
 If Rng = 0 Then
 i = i + 1
 ElseIf Rng = "" Then
 i = i + 1
 ElseIf Rng = 1 Then
 i = i + 1
 ElseIf Rng = 2 Then
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 i = i + 2
 ElseIf Rng = 3 Then
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 i = i + 3
 ElseIf Rng = 4 Then
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 i = i + 4
 Else
 Stop
 End If
Wend

• Marc-Andre: You should try to edit your title to represent what the code do, not what you want in your review. The review you are looking for should be in the body of your question.
• Raystafarian: What are you trying to do? Go through a range and insert rows based on the number in a particular cell value?

Answer 1

Using a Select will definitely shorten up your code.

While i <= 300
 Set Rng = Range("J" & i)
 Select Case Rng.Value
 Case 0, 1, vbNullString
 i = i + 1
 Case 2
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 i = i + 2
 Case 3
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 i = i + 3
 ' etc.
 End Select
Wend

The next step would be to extract a method to eliminate all of the duplication. It should take in a Range parameter and perform your copy/insert. Basically anytime you hit Ctrl + C you should stop and write a method instead.

Answer 2

You have a fair bit of duplicate code which can be extracted into another proc:

Private Sub CopyAndInsert(ByRef Rng As Range, numLoops As Integer)
Dim i As Integer
 For i = 1 To numLoops
 Rng.Offset(, -9).Resize(, 125).Copy
 Rng.Offset(, -9).Insert Shift:=xlDown
 Next i
End Sub

You can also replace your If ... End If with a Select Case statement.

Sub Test()
Dim Rng As Range
Dim i As Long
Dim numLoops As Integer
i = 3
 While i <= 300
 Set Rng = Range("J" & i)
 Select Case Rng.Value
 Case 0, 1, ""
 i = i + 1
 Case 2 To 4
 numLoops = Rng.Value - 1
 CopyAndInsert Rng, numLoops
 i = i + numLoops + 1
 Case Is > 4
 ' Do you really want to use "Stop" here?
 Case Else
 ' What should happen here?
 End Select
 Wend
End Sub

You should also look at using Application.ScreenUpdating and Application.Calculate as ways of improving the speed at which code runs.