CODEWITHSUNDEEP
vbaexcelmacros
KeOt777
KeOt777

Reputation: 247

VBA Macro Excecutes more than once

It's the first time I'm trying some VBA code, so it might be a very noob mistake but I just can't see it, this is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
        If InRange(ActiveCell, Range("N4:N33")) Then
            If InStr(1, ActiveCell.Text, "EFECTIVO") > 0 Then
                If (Not IsEmpty(ActiveCell.Offset(0, -1))) Then
                    If (ActiveCell.Offset(0, -1).Value > 0) Then
                        Cancel = True
                        Call RestaEfectivo
                        Range("F4").Select
                    End If
                End If
            End If
        End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
    InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function

Sub RestaEfectivo()
    Range("F4").Value = Range("F4").Value - ActiveCell.Offset(0, -1).Value
End Sub

The idea is that I have a dropdown list on my cells N4 to N33, whenever I choose the option "EFECTIVO" it should take the value to the left of the ActiveCell (N#) and substract its value from the F4 cell. In essence F4 = F4 - N#.

The code does what it's supposed to do, however, it appears to execute 50 times? The original value of my F4 cell is 230, once I execute the code it turns into -20

Any idea where I messed up or if I'm missing some code, validation, etc?

As I said, I'm new to VBA for Excel Macros, so don't worry about pointing out noob mistakes.

Upvotes: 0

Views: 298

Answers (1)

Robin Mackenzie
Robin Mackenzie

Reputation: 19319

You need to toggle the EnableEvents property of Application at the point where you call your RestaEfectivo sub-routine. Notice that during handling the Worksheet_Change event you call the RestaEfectivo sub-routine which fires the worksheet change event again - that is why your macro executes more than once.

You can make the code change like this:

Cancel = True

' turn off events to enable changing cell value without a new 'change' event
Application.EnableEvents = False

Call RestaEfectivo

' re-enable events to ensure normal application behaviour
Application.EnableEvents = True

Range("F4").Select

Update

OP asked a follow up question - how to make the range dynamic but ignore the bottom row as this would contain a SUM formula.

One possible solution is to check for the change in any cell of column N:

If InRange(ActiveCell, Range("N:N")) Then

And then recode the InRange sub - see the code comments for logic and assumptions:

Function InRange(Range1 As Range, Range2 As Range) As Boolean

    Dim blnInRange As Boolean
    Dim blnResult As Boolean
    Dim blnCellHasSumFormula As Boolean
    Dim blnCellIsEmpty As Boolean

    'primary check for cell intersect
    blnInRange = Not (Application.Intersect(Range1, Range2) Is Nothing)

    If blnInRange Then
        'follow-up checks
        blnCellIsEmpty = (Range1.Value = vbNullString)
        If blnCellIsEmpty Then
            'cell in range but empty - assume beneath row with SUM
            blnResult = False
        Else
            If Range1.HasFormula Then
                'check for sum formula
                blnCellHasSumFormula = (InStr(1, Range1.Formula, "SUM(", vbTextCompare) > 0)
                If blnCellHasSumFormula Then
                    ' cell in the SUM row
                    blnResult = False
                Else
                    ' cell is in range, not empty and not a SUM formula
                    blnResult = True
                End If
            Else
                'assume non-empty cell without formula is good
                blnResult = True
            End If
        End If
    Else
        blnResult = False
    End If

    'return to event handler
    InRange = blnResult

End Function

Upvotes: 1

Related Questions