-1

When "Add 2 points" is detected in "N4:N203", I need to add 2 to corresponding cell in "E4:K4". Then copy "AB4:AB203" to "O4:O203" to "O4:O203".

Sub Moving_tees_add_2()
Dim PointsToAdd As Integer

    PointsToAdd = 2

        Sheets("MEMBERS1").Select
Application.ScreenUpdating = False
            Range("C4").Select

    Do Until ActiveCell.Row = 204

        If ActiveCell.Range("L1").Value = ("Add 2 points") Then
        If ActiveCell.Range("C1").Value <> "n/a" Then ActiveCell.Range("C1").Value = ActiveCell.Range("C1").Value + PointsToAdd
        If ActiveCell.Range("D1").Value <> "n/a" Then ActiveCell.Range("D1").Value = ActiveCell.Range("D1").Value + PointsToAdd
        If ActiveCell.Range("E1").Value <> "n/a" Then ActiveCell.Range("E1").Value = ActiveCell.Range("E1").Value + PointsToAdd
        If ActiveCell.Range("F1").Value <> "n/a" Then ActiveCell.Range("F1").Value = ActiveCell.Range("F1").Value + PointsToAdd
        If ActiveCell.Range("G1").Value <> "n/a" Then ActiveCell.Range("G1").Value = 
    ActiveCell.Range("G1").Value + PointsToAdd
        If ActiveCell.Range("H1").Value <> "n/a" Then ActiveCell.Range("H1").Value =  
    ActiveCell.Range("H1").Value + PointsToAdd
        If ActiveCell.Range("I1").Value <> "n/a" Then ActiveCell.Range("I1").Value = 
    ActiveCell.Range("I1").Value + PointsToAdd
        
        If ActiveCell.Range("C1").Value <> "n/a" Then ActiveCell.Range("Q1").Value = 
    ActiveCell.Range("Q1").Value + PointsToAdd
        If ActiveCell.Range("D1").Value <> "n/a" Then ActiveCell.Range("R1").Value = 
    ActiveCell.Range("R1").Value + PointsToAdd

    Range("AB4:AB203").Select
    Selection.Copy
    Range("O4:O203").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'ActiveCell.Range("A1").Select
    '
    '        Selection.ClearContents
    Range("N4:N203").Select
        Selection.ClearContents
    End If

        ActiveCell.Offset(1, 0).Range("A1").Select
    
    Loop
Kostas K.
  • 8,293
  • 2
  • 22
  • 28

1 Answers1

0

Without all the select/activate:

Sub Moving_tees_add_2()
    Dim PointsToAdd As Long, rw As Long, ws As Worksheet, c As Range

    Set ws = ThisWorkbook.Sheets("MEMBERS1") 'use a worksheet reference
    PointsToAdd = 2

    Application.ScreenUpdating = False
            
    For rw = 4 To 204
        With ws.Rows(rw)
            If .Columns("N").Value = "Add 2 points" Then
                'loop over the range to be incremented
                For Each c In .Range("E1:K1,S1:T1").Cells
                    If c.Value <> "n/a" Then c.Value = c.Value + PointsToAdd
                Next c
                'you can directly assign the value from one range to another,
                '  without copy/pastespecial
                ws.Range("O4:O203").Value = ws.Range("AB4:AB203").Value
            End If
        End With
    Next rw

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125