Syntax needed to exit a Worksheet_Change for multiple ranges subroutine if more than one target

Question

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rngF As Range, rngC As Range
    Dim aCell As Range, bCell As Range
    Dim wkSheet1 As Worksheet

    'recursive error prevention
    On Error GoTo Whoa
    Application.EnableEvents = False

    If Target.Cells.CountLarge > 1 Then GoTo Letscontinue

    '___set range
    Set wkSheet1 = ThisWorkbook.Worksheets("backend")

    Set rngF = wkSheet1.Range("C5:C500,H5:H500,M5:M500,R5:R500,W5:W500,AB5:AB500" & _
              ",AG5:AG500,AL5:AL500,AQ5:AQ500,AV5:AV500,BA5:BA500,BF5:BF500," & _
              "BK5:BK500,BP5:BP500,BU5:BU500,BZ5:BZ500,CE5:CE500,CO5:CO500," & _
              "CT5:CT500,CY5:CY500,DD5:DD500,DI5:DI500,DN5:DN500," & _
              "DS5:DS500,DX5:DX500,EC5:EC500")
    Set rngC = wkSheet1.Range("D5:D500,I5:I500,N5:N500,S5:S500,X5:X500,AC5:AC500," & _
               "AH5:AH500,AM5:AM500,AR5:AR500,AW5:AW500,BB5:BB500,BG5:BG500," & _
               "BL5:BL500,BQ5:BQ500,BV5:BV500,CA5:CA500,CF5:CF500,CP5:CP500," & _
               "CU5:CU500,CZ5:CZ500,DE5:DE500,DJ5:DJ500,DO5:DO500," & _
               "DT5:DT500,DY5:DY500,ED5:ED500")


    'fORECAST

    If Not Application.Intersect(Target, rngF) Is Nothing Then
        '~~> Loop through all cells in the range
        For Each aCell In rngF
            If aCell.Value <> "" Then
                If aCell.Value <> "N/A,TBC,TBA,TBD" Then
                    If aCell.Value < Date Then
                        aCell.ClearContents
                        MsgBox "The Forecast date you have specified " & _
                        "may not occur in the past. Please try again"
                    Else
                    End If
                End If
            End If
        Next
    End If

    'complete

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Application.Intersect(Target, rngC) Is Nothing Then
        '~~> Loop through all cells in the range
        For Each bCell In rngC
            If bCell.Value <> "" Then
                If bCell.Value > Date Then
                    bCell.ClearContents
                    MsgBox "The Forecast date you have specified " & _
                    "may not occur in the past. Please try again"
                Else
                End If
            End If
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

The question: I used If Target.Cells.Count > 1 Then Exit Sub to try get the sub to exit as soon as more than 1 cell had been affected. IE: After a single target cell in any of the specific ranges is affected, stop executing the clear cell contents on any others. Im sure my syntax is wrong or the logic needs a tweak. I've omitted part of the code that isn't affected.

Unlike forum sites, we don't use "Thanks", or "Any help appreciated", or signatures on [so]. See "[Should 'Hi', 'thanks,' taglines, and salutations be removed from posts?](http://meta.stackexchange.com/questions/2950/should-hi-thanks-taglines-and-salutations-be-removed-from-posts). BTW, it's "Thanks in advance", not "Thanks in advanced". — John Saunders, May 29 '15 at 00:53

score 1 · Answer 1 · edited May 23 '17 at 12:30

If Target.Cells.Count > 1 Then Exit Sub is good enough :) However this line can give you error in Excel 2007+

Target.Cells.Count returns an Integer and it will give you an error in Excel 2007+ if the number of cells affected as they can be of Long Type

For Excel 2007+ use the below

If Target.Cells.CountLarge > 1 Then Exit Sub

Note: You need to add the line before you switch off events. Else instead of Exit Sub, you will have to say

If Target.Cells.CountLarge > 1 Then GoTo LetsContinue

Where LetsContinue is where you do the clean up as shown Here

Example 1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub

    On Error GoTo Whoa

    Application.EnableEvents = False

    '~~> Your code

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Example 2

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Target.Cells.CountLarge > 1 Then GoTo Letscontinue

    '~~> Your code

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Followup From Comments

Ah I think you misunderstood how the _Change Event Fires :) This event will fire if any cell is changed. Target.Cells.CountLarge checks for the number of cells that are changed right now. For example if you copy and paste values in say Cell A1:A5 then it means 5 cells are being changed at the moment.

What you want to do is run a piece of code when the user input a date in the userform. If that is correct then this code is what you need. I am using Sub Update() You may have to put it in the CommandButton Code (if you are using that)

Also you do not need to type the entire range. See how I am creating the range using a loop.

Note: The below code is Untested.

Option Explicit

Sub Update()
    Dim rngF As Range, rngC As Range
    Dim aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("backend")

    With ws
        '~~> This creates your range
        For i = 3 To 133 Step 5
            If rngF Is Nothing Then
                Set rngF = .Range(ReturnName(i) & "5:" & ReturnName(i) & 500)
            Else
                Set rngF = Union(rngF, .Range(ReturnName(i) & "5:" & ReturnName(i) & 500))
            End If

            If rngC Is Nothing Then
                Set rngC = .Range(ReturnName(i + 1) & "5:" & ReturnName(i + 1) & 500)
            Else
                Set rngC = Union(rngC, .Range(ReturnName(i + 1) & "5:" & ReturnName(i + 1) & 500))
            End If
        Next i
    End With

    'Debug.Print rngF.Address
    'Debug.Print rngC.Address

    '~~> Forecast
    '~~> Loop through all cells in the range
    For Each aCell In rngF
        If aCell.Value <> "" Then
            If aCell.Value <> "N/A,TBC,TBA,TBD" Then
                '<~~ Is this the date from userform. If yes then 
                '<~~ use a variable and input it below instead of `Date`
                If aCell.Value < Date Then 
                    aCell.ClearContents
                    MsgBox "The Forecast date you have specified " & _
                    "may not occur in the past. Please try again"
                    Exit For '<~~ This will exit the For Loop. To exit the sub use `Exit Sub`
                End If
            End If
        End If
    Next

    '~~> Complete
    '~~> Loop through all cells in the range
    For Each bCell In rngC
        If bCell.Value <> "" Then
            '<~~ Is this the date from userform. If yes then 
            '<~~ use a variable and input it below instead of `Date`
            If bCell.Value > Date Then
                bCell.ClearContents
                MsgBox "The Forecast date you have specified " & _
                "may not occur in the past. Please try again"
                Exit For '<~~ This will exit the For Loop. To exit the sub use `Exit Sub`
            Else
            End If
        End If
    Next
End Sub

Function ReturnName(ByVal num As Integer) As String
    ReturnName = Split(Cells(, num).Address, "$")(1)
End Function

Siddharth!! Thanks so so so much for you answer! It feels really great to get YOUR answer as it was one of your original answers that I built the code off of. The irony that you answered this is crazy. So for the original, and this update THANKS!! :) — Dylan, May 28 '15 at 11:35
Thank you for the kind comments :) Yes I know it was based on the code that I wrote. No one actually uses `'~~>` or `Whoa` other than me :D — Siddharth Rout, May 28 '15 at 11:39
Sorry Siddharth, I tried both examples but the macro still identified and cleared more than the single specific cell i needed to check. Basically I entered in a date yesterday, that gets cleared today when the sub runs... — Dylan, May 28 '15 at 11:50
@Dylan don't hesitate to accept the answer if it works: it will tell other users with your same problem that this is the solution. — Matteo NNZ, May 28 '15 at 11:50
Thanks Matteo NNZ, it hasnt resolved just yet. I was just excited to get SIddharth's response as his was the code I originally got inspired from — Dylan, May 28 '15 at 11:54
@Dylan: I indented your code. I see an EndIf missing. besides that I don't see any problem with the code. Can you explain what were you truing to do and what were you expecting and what results did you actually get? — Siddharth Rout, May 28 '15 at 12:05
@SiddharthRout, essentially I use a userform to input dates into this hidden 'backend' sheet. the inputs go into the specified ranges.As you can see, this sub prevents you from choosing a past date for forecast. If I set a forecast date today, as today's date: ie I input 28/05/2015 now. Then, if I come into the file tommorrow and change any other value, it causes the sub to run and then deletes the 28/05/2015 date i specified yesterday. So i was hoping i could get the sub to run on 1 specific cell, then stop checking the rest, as they may be in the past but that data must be preserved. — Dylan, May 28 '15 at 12:16
Ah I think you misunderstood how the _Change Event Fires :) This event will fire if any cell is changed. `Target.Cells.CountLarge` checks for the number of cells that are changed right now. For example if you copy and paste values in say Cell A1:A5 then it means 5 cells are being changed at the moment — Siddharth Rout, May 28 '15 at 12:19
@SiddharthRout oh I see! so its the incorrect event for what I am trying to do?? Could you suggest a different Event for this? is there a different type of _change event? — Dylan, May 28 '15 at 12:26
Yes that would work perfectly! If I can only input into 1 cell at a time, I only need the Sub to run for that 1 cell. then the sub can exit. :) — Dylan, May 28 '15 at 12:49
@Dylan: I have updated the post. See the section `Followup From Comments` You may have to refresh the page — Siddharth Rout, May 28 '15 at 12:56

Syntax needed to exit a Worksheet_Change for multiple ranges subroutine if more than one target

1 Answers1