VBA Limit Macro to Just Certain Columns is Not Working-CodePudding

I have the following code that will update cells to 1-5 based on doubleclicks on the cell. I'm now looking to limit this to just a few columns in the spreadsheet instead of anywhere (e.g. if I doubleclick on A2, nothing should happen). Clearly the .Columns("B:C") is not in the right spot - any idea how to fix this?

Private Sub Worksheet.Columns("B:C")_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True



If Target.Value < 5 Then
   Target.Value = Target.Value   1

Else
  Target.Value = 5

End If


End Sub

CodePudding user response：

As mentioned by Scott Craner in the comments, the proper way to handle this is to test if the Target range intersects the columns.

I would also recommend setting Cancel = True. This prevents the cell from going into edit mode.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Columns("B:C"), Target) Is Nothing Then
        If Target.Value < 5 Then
            Target.Value = Target.Value   1
        Else
            Target.Value = 5
        End If
        Cancel = True
    End If
End Sub

CodePudding user response：

A Worksheet Before Double-Click: Increment Cell Value

Adjust the values in the event procedure.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Reference (set) the range (columns).
    Dim srg As Range: Set srg = SetColumnsUR(Me, "B2:C2,E2,G2:H2")
    ' Check if the double-clicked cell ('Target') doesn't intersect.
    If Intersect(srg, Target) Is Nothing Then Exit Sub
    ' Write the integer according to the logic.
    Target.Value = MyIntegerLogic(Target.Value, 1, 5)
    ' Suppress the default behavior of double-clicking a cell.
    Cancel = True
End Sub

Function SetColumnsUR( _
    ByVal ws As Worksheet, _
    ByVal FirstRowAddress As String) _
As Range
    With ws.Range(FirstRowAddress)
        With .Areas(1).Resize(ws.Rows.Count - .Row   1)
            Set SetColumnsUR = Intersect(.Cells, ws.UsedRange)
        End With
        If .Areas.Count = 1 Then Exit Function
        Set SetColumnsUR = Intersect(SetColumnsUR.EntireRow, .EntireColumn)
    End With
End Function

Function MyIntegerLogic( _
    ByVal Value As Variant, _
    ByVal MinInteger As Long, _
    ByVal MaxInteger As Long) _
As Long
    Dim Number As Long: Number = MinInteger - 1
    If VarType(Value) = vbDouble Then ' is a number
        If Int(Value) = Value Then ' is a whole number (integer)
            Select Case Value
                Case MinInteger To MaxInteger - 1: Number = Value   1 ' 1.)
                Case MaxInteger: Number = MaxInteger ' 2.)
                Case Else ' covered below
            End Select
        End If
    End If
    If Number = MinInteger - 1 Then Number = MinInteger ' 3.) all other cases
    MyIntegerLogic = Number
End Function