Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA Workshhet Change - Limit the Change Just For Specific Range

Tags:

excel

vba

I have a trigger that I want to use in certain worksheet - just inside 2 specific columns. But whan I enter a value inside another range it triggers the Private Sub of that worksheet. I want it would start to work just whan I cange value within columns E or H. Is someone knows how to do it right?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LR As Long
Dim rng1 As Range
Dim rng2 As Range

'WE WANT TO KEEP THE TARGET COLUMNS BETWEEN 0% TO 100%
LR = Cells(Rows.Count, "A").End(xlUp).Row

Set rng1 = Intersect(Target, Range(Cells(2, "E"), Cells(LR, "E")))

On Error GoTo 1
If Target.Value < 0 Or Target.Value > 1 Then
    MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
    Target.Value = 0
    Exit Sub
End If

On Error GoTo 1
Set rng2 = Intersect(Target, Range(Cells(2, "H"), Cells(LR, "H")))
If Target.Value < 0 Or Target.Value > 1 Then
    MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
    Target.Value = 0
    Exit Sub
End If


1
End Sub
like image 936
Rafael Osipov Avatar asked Oct 26 '25 09:10

Rafael Osipov


2 Answers

You just need to check if Target intersects with your desired range. I would Union the two columns together in this check.

As cryptically stated by DisplayName, since Target can contain more than one cell, you should check each cell in target individually. Alternatively, if your intention for Target was to always have one cell, then you can avoid the For...Each statement altogether and use this check: If Target.Cells.Count > 1 Then Exit Sub to not run the procedure when more than 1 cell is changed.

I also added another intersect target, Me.Rows("2:" & rows.count) to avoid updating any headers you may have. If your data does not contain headers, then you can remove this range from Intersect().

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo safeExit

    Dim rngIntersect As Range
    Set rngIntersect = Intersect(Target, Union(Me.Columns("E"), Me.Columns("H")), _
                                                        Me.Rows("2:" & Rows.Count))

    If Not rngIntersect Is Nothing Then

        Application.EnableEvents = False

        Dim cel As Range
        For Each cel In rngIntersect
            If cel.Value < 0 Or cel.Value > 1 Then
                MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, _
                                                                                "error"
                cel.Value = 0
            End If
        Next cel

    End If

safeExit:

    Application.EnableEvents = True

End Sub

As a side note, when you are using the same exact range more than once, it's not a bad idea to go ahead and set that range to a variable. So, we use rngIntersect twice in this code, so this prevents us from having to issue multiple calls to the Intersect() and Union() functions. On top of that, you run into less debugging headaches when you only have to update the range in one place rather than multiple times in your code.

like image 187
K.Dᴀᴠɪs Avatar answered Oct 29 '25 00:10

K.Dᴀᴠɪs


The intersect can check if any of the cells in Target (yes, Target can be more than a single cell) intersect with the Union of columns E and H.

Private Sub Worksheet_Change(ByVal Target As Range)

    ' this next line could also be,
    'If Not Intersect(Target, Range("E:E, H:H")) Is Nothing Then
    If Not Intersect(Target, Union(Range("E:E"), Range("H:H"))) Is Nothing Then
        On Error GoTo bye_bye
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Union(Range("E:E"), Range("H:H")))
            If (t.Value2 < 0 Or t.Value2 > 1) And t.Row > 1 Then
                MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
                t = 0
            End If
        Next t
    End If

bye_bye:
    Application.EnableEvents = True
End Sub