Replace repititious code with a loop?

[Hawkeye249]

Hello,

I'm using a worksheet is used to tally survey results.
It's working well and I want to make it better.
Each row corresponds to a question number.
In use, the code locks cursor positioning into B and the User types the number for the box checked on the card. The code increments the count for that response for that question and moves the cursor to the next row.
All good.
Buttons were added to auto-record when the card shows all 1's, all 2's, etc. Users have asked that for the All X's buttons, I just set the value for all questions but have a separate "commit" button. That way, when a card is scored that has all 1's except for a few other values, they can use the All 1's button, adjust the individual questions as needed, and then use the "commit" button to record the scores. (Difficult to explain when you can't see the worksheet.)
If you have followed me, the difficulty in doing this is the way I wrote the code. I used the built-in event, "Worksheet_Change" to react to a score being entered. In that routine, I check to see which row I'm on and react accordingly. But that code is repeated for every row because I couldn't make a tight loop do the job.
Following is the beginning of the routine and the code for the first two rows tallied - it is repeated 55 times. If I could make a tight loop out of the code, I could easily do what the Users requested.
Thanks in advance for your assistance!
Bob

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If booSkipChg Then 'ROUTINE EXECUTES FOR *EVERY* CHANGE IN THE WORKSHEET!
Exit Sub 'IF CLEARING CELLS, SKIP
End If
If Target.Column <> 2 Then 'TEST IF TARGET CELL IS IN COLUMN B (2) ONLY
Exit Sub
End If
If Target.Value < 1 Or Target.Value > 5 Then
ActiveCell.Offset(rowoffset:=0, columnoffset:=-1).Activate
response = MsgBox("You must type a value between 1 and 5", vbCritical + vbOKOnly, "ERROR")
Exit Sub
End If
If .Address = [$b$6].Address Then
Select Case .Value
Case 1
With [$c$6]
.Value = .Value + 1
End With
Case 2
With [$d$6]
.Value = .Value + 1
End With
Case 3
With [$e$6]
.Value = .Value + 1
End With
Case 4
With [$f$6]
.Value = .Value + 1
End With
Case 5
With [$g$6]
.Value = .Value + 1
End With
End Select
Range("$B$7").Activate
Exit Sub
End If
If .Address = [$b$7].Address Then
Select Case .Value
Case 1
With [$c$7]
.Value = .Value + 1
End With
Case 2
With [$d$7]
.Value = .Value + 1
End With
Case 3
With [$e$7]
.Value = .Value + 1
End With
Case 4
With [$f$7]
.Value = .Value + 1
End With
Case 5
With [$g$7]
.Value = .Value + 1
End With
End Select
Range("$B$8").Activate
Exit Sub
End If
...
... 'Following is the end, MANY lines later
...
Range("$B$6").Activate
Exit Sub
End If
End With
End Sub

[EricDV]

'does this work??
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strCell
    Dim astrColumn() As String
       
    With Target
        If booSkipChg Then 'ROUTINE EXECUTES FOR *EVERY* CHANGE IN THE WORKSHEET!
            Exit Sub 'IF CLEARING CELLS, SKIP
        End If
        If Target.Column <> 2 Then 'TEST IF TARGET CELL IS IN COLUMN B (2) ONLY
            Exit Sub
        End If
        If Target.Value < 1 Or Target.Value > 5 Then
            ActiveCell.Offset(rowoffset:=0, columnoffset:=-1).Activate
            response = MsgBox("You must type a value between 1 and 5", vbCritical + vbOKOnly, "ERROR")
            Exit Sub
        End If
        astrColumn = Split("C D E F G", " ")
        strCell = "$" & astrColumn(.Value - 1) & "$" & Right(.Address, Len(.Address) - InStrRev(.Address, "$"))
        Evaluate(strCell).Value = Evaluate(strCell).Value + 1
    End With
End Sub

[beuls]

can't you put the code that is repeated in a separate function and call it?

[EricDV]

Sure you can, but why bother?
The following three lines replace all of the repetitious code:

astrColumn = Split("C D E F G", " ")
strCell = "$" & astrColumn(.Value - 1) & "$" & Right(.Address, Len(.Address) - InStrRev(.Address, "$"))
Evaluate(strCell).Value = Evaluate(strCell).Value + 1