Mason R
Mason R

Reputation: 51

Check values in a range before continuing

So right now I have an excel workbook for a task tracker. When the column that contains the completed date is filled in, it will take that row and copy it onto another sheet ("Complete") then delete it off the current sheet ("Current"). What I would like it to do before this is executed is check the values of columns H through M for either a "C" or "U". If any of the Cells in that range do not contain either or, then I want it to exit out and display a message. I am not to familiar with Excel or VBA, but decent with C++.

Here is the code as of right now:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

Dim receivedDate As Range, nextOpen As Range, isect As Range

Set receivedDate = Sheet1.Range("G3:G166")
Set isect = Application.Intersect(Target, receivedDate)

If Not (isect Is Nothing) And IsDate(Target) = True Then
    Set nextOpen = Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Target.EntireRow.Copy Destination:=nextOpen.EntireRow
    Target.EntireRow.Delete
End If

Application.EnableEvents = True

End Sub

Here is snip of what I have going on...

snip of work

Any help would be greatly appreciated. Sorry I tried looking around some.

Upvotes: 0

Views: 80

Answers (1)

Tim Williams
Tim Williams

Reputation: 166331

Edit - more robust, added error handler and multi-cell update handling

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim receivedDate As Range, nextOpen As Range, isect As Range
    Dim rngHM As Range, c As Range, rngDel As Range

    Set receivedDate = Sheet1.Range("G3:G166")
    'are any of the changed cells in the range we're monitoring?
    Set isect = Application.Intersect(Target, receivedDate)

    On Error GoTo haveError 'error handler ensures events get re-enabled...

    '### remember that Target can contain >1 cell...
    For Each c In isect.Cells
        If IsDate(c.Value) Then
            With c.EntireRow

                Set rngHM = .Cells(1, "H").Resize(1, 6)
                'EDIT: all cells must be C or U
                If (Application.CountIf(rngHM, "C") + _
                   Application.CountIf(rngHM, "U")) <> rngHM.Cells.Count Then

                    MsgBox "No C or U on row " & c.Row & " !"

                Else

                    Set nextOpen = Sheet4.Range("A" & Rows.Count) _
                                      .End(xlUp).Offset(1, 0)
                    .Copy Destination:=nextOpen.EntireRow

                    'deleting rows while looping gives odd results,
                    '  so store them up until done...
                    If rngDel Is Nothing Then
                        Set rngDel = c
                    Else
                        Set rngDel = Application.Union(rngDel, c)
                    End If

               End If

            End With 'entirerow
        End If   'is date
    Next c

    'delete any copied rows in a single operation
    If Not rngDel Is Nothing Then
        Application.EnableEvents = False
        rngDel.EntireRow.Delete
        Application.EnableEvents = True
    End If

    Exit Sub

haveError:
    'if your code errors out then this makes sure event handling gets reset
    Application.EnableEvents = True

End Sub

Upvotes: 2

Related Questions