CODEWITHSUNDEEP
vbaexcel
Dead_Jester
Dead_Jester

Reputation: 602

Excel VBA Macro delete row infinite loop

I have a VBA macro that is intended to format a specified range of cells automatically for the user and it does so correctly. However when the user tries to delete a row in the specified range it triggers the error message I built in as an infinite loop.

The code looks like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rTimeCells As Range

    Set rTimeCells = Range("D2:G15")

    Application.EnableEvents = False


    If Not Application.Intersect(rTimeCells, Range(Target.Address)) Is Nothing Then
            Call Time_Format(Range(Target.Address))
    End If

    Application.EnableEvents = True

    End Sub

    Private Sub Time_Format(rCells As Range)
    Dim RegEXFormat1 As Object
    ...
    Dim RegEXFormatX As Object

    Set RegEXFormat1 = CreateObject("VBScript.RegExp")    
    ...
    Set RegEXFormatX = CreateObject("VBScript.RegExp")


    RegEXFormat1.Global = True
    ...
    RegEXFormatX.Global = True


    RegEXFormat1.IgnoreCase = True
    ...
    RegEXFormatX.IgnoreCase = True

    RegEXFormat1.Pattern = "..."
    ...
    RegEXFormatX.Pattern = "..."


    For Each cell In rCells
        Dim sValue As String
        Dim sMonth As String
        Dim sDay As String
        Dim sYear As String
        Dim bCorrectFormat As Boolean

        bCorrectFormat = True
        sValue = CStr(cell.Text)

        If (RegEXFormat1.test(sValue)) Then
        ...
        ElseIF(RegEXFormatX.test(sValue) Then
        ...
        Else
            If (sValue = "" Or sValue = "<Input Date>") Then
            Else
                MsgBox ("Please Input the date in correct numeric format")
                cell.value = "<Input Date>"
        End If
    Next

The user insists that they need the ability to delete rows of data without sending this macro into a loop. How can I modify what I have here to allow for this occurrence?

(I clearly modified the code and left a lot out that I dont feel was necessary here and to stop my post from being pages and pages long.)

Upvotes: 1

Views: 766

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

Instead of this:

If Not Application.Intersect(rTimeCells, Range(Target.Address)) Is Nothing Then
     Call Time_Format(Range(Target.Address))
End If

you probably want to limit the range you pass to Time_Format using something like this:

Dim rngTime as Range
Set rngTime = Application.Intersect(rTimeCells, Target)
If Not rngTime Is Nothing Then
     Call Time_Format(rngTime)
End If

Note: Range(Target.Address) is equivalent to Target

Upvotes: 1

Related Questions