Help with script

[brian.yanik]

I have the following VB script running on an excel spreadsheet. It works great for a limited number of cells, however I need to expand it to cover 150 cells (cell EY) over 50 rows. What I need to do is enter a number for various columns, add that to the existing total for each adjacent column, then clear the number entered. Is there an easier way to define the "Case" and "Range" than I am currently using?

Here's the script:

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target.Address
Case "$B$3"
Range("C3")=Range("C3") + Target
Target.Value=""
Case "$D$3"
Range("E3")=Range("E3") + Target
Target.Value=""
Case "$F$3"
Range("G3")=Range("G3") + Target
Target.Value=""
Case "$H$3"
Range("I3")=Range("I3") + Target
Target.Value=""
Case "$J$3"
Range("K3")=Range("K3") + Target
Target.Value=""
Case "$L$3"
Range("M3")=Range("M3") + Target
Target.Value=""
Case "$N$3"
Range("O3")=Range("O3") + Target
Target.Value=""
Case "$P$3"
Range("Q3")=Range("Q3") + Target
Target.Value=""
Case "$R$3"
Range("S3")=Range("S3") + Target
Target.Value=""
Case Else
Exit Sub
End Select
End Sub

Any help to expand this would be greatly appreciated.

 

[Andrew Poulsom]

Welcome to the Board.

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row <> 3 Then Exit Sub
    If Target.Column Mod 2 = 1 Then Exit Sub
    If Application.Intersect(Target, Range("B3:R3")) Is Nothing Then Exit Sub
    Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
    Target.Value = ""
End Sub

 

[VoG]

Hello and welcome to MrExcel.

Does this work as expected?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
    Offset(, 1).Value = Offset(, 1).Value + .Value
    .ClearContents
End With
Application.EnableEvents = True
End Sub

 

[yytsunamiyy]

try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col_even

Application.EnableEvents = False
Col_even = Target.Column Mod 2

If Target.Row = 3 And Col_even > 0 Then
    Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
    target.clearcontents
End If

Application.EnableEvents = True

End Sub

 

[lenze]

Hi and Welcome to the Board!!!
Give this a try

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column Mod 2 <> 0 Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
Target.ClearContents
Application.EnableEvents = True
End Sub

lenze

 

[brian.yanik]

Andrew,
This works great for the one row!! Thank you!
Now how can I expand it to cover 50 rows?

Brian

 

[brian.yanik]

Lenze,

I used your post:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column Mod 2 <> 0 Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
Target.ClearContents
Application.EnableEvents = True
End Sub

And it does what we need..THANK YOU!!