Results 1 to 4 of 4
  1. #1
    3 Star Lounger
    Join Date
    May 2002
    Location
    Mpls, Minnesota, USA
    Posts
    271
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Check cells for valid (Excel 2003)

    Seeking help with VBA solution.
    I have a large workbook that I use to process information. I need a macro that will check entries in one column to make sure they are valid. The row count varies and may be up to 1,000. There is a better explaination on the attached workbook.
    Any help would be appreciated.

    Thanks for your thoughts,
    Chuck
    Chuck Reimer
    I'm from the Government and I'm here to help...

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Check cells for valid (Excel 2003)

    See if this does what you want.

    <code>
    Public Sub CkValid()
    Dim I As Long, lIMax As Long, lErrCnt As Long
    With Worksheets("Sheet1")
    lIMax = .Range("C65536").End(xlUp).Row - 1
    lErrCnt = 0
    For I = 1 To lIMax
    If .Range("C1").Offset(I, 0).Value < 73900 Or .Range("C1").Offset(I, 0).Value > 74099 Then
    If .Range("D1").Offset(I, 0).Value <> "000" Then
    .Range("D1").Offset(I, 0).Interior.ColorIndex = 3
    lErrCnt = lErrCnt + 1
    End If
    Else
    If Len(.Range("D1").Offset(I, 0).Value) <> 3 Or Left(.Range("D1").Offset(I, 0).Value, 1) <> "7" Then
    .Range("D1").Offset(I, 0).Interior.ColorIndex = 3
    lErrCnt = lErrCnt + 1
    End If
    End If
    Next I
    MsgBox "There are " & lErrCnt & " errors."
    End With
    End Sub
    </code>
    Legare Coleman

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Check cells for valid (Excel 2003)

    I know you got code from Legare, here is my attempt. I differentiate between some errors:

    <pre>Option Explicit
    Sub ValidateSubC()
    Dim sMsg As String
    Dim rng As Range
    Dim rCell As Range
    Dim lErrors As Long
    Dim lErrOrg As Long
    Dim lErrText As Long
    Dim lErrValue As Long
    Dim vOrg As Variant
    Dim vSubC As Variant
    Set rng = Range(Range("c3"), Range("c65536").End(xlUp))

    lErrors = 0
    lErrOrg = 0
    lErrText = 0
    lErrValue = 0
    For Each rCell In rng
    With rCell
    vOrg = .Value
    vSubC = .Offset(0, 1).Value
    .Interior.ColorIndex = xlNone
    .Offset(0, 1).Interior.ColorIndex = xlNone
    If Not IsNumeric(vOrg) Then
    .Interior.Color = vbYellow
    lErrors = lErrors + 1
    lErrOrg = lErrOrg + 1
    ElseIf Not Application.WorksheetFunction. _
    IsText(vSubC) Then
    .Offset(0, 1).Interior.Color = vbRed
    lErrors = lErrors + 1
    lErrText = lErrText + 1
    ElseIf vOrg >= 73900 And _
    vOrg <= 74099 Then
    If Len(vSubC) <> 3 Or _
    Left(vSubC, 1) <> 7 Then
    .Offset(0, 1).Interior.Color = vbCyan
    lErrors = lErrors + 1
    lErrValue = lErrValue + 1
    End If
    Else
    If vSubC <> "000" Then
    .Offset(0, 1).Interior.Color = vbCyan
    lErrors = lErrors + 1
    lErrValue = lErrValue + 1
    End If
    End If
    End With
    Next
    If lErrors = 0 Then
    sMsg = "There are no errors to mark"
    ElseIf lErrors = 1 Then
    sMsg = "There is 1 Error marked" & vbCrLf
    If lErrOrg > 0 Then
    sMsg = sMsg & vbCrLf & _
    "it is an error in the 'Org Value'"
    ElseIf lErrText > 0 Then
    sMsg = sMsg & vbCrLf & _
    "'SubC' Value is not 'Text'"
    Else
    sMsg = sMsg & vbCrLf & _
    "it is an error in the 'SubC Value'"
    End If
    Else
    sMsg = "There are " & lErrors & " Errors marked" & vbCrLf
    If lErrOrg > 0 Then _
    sMsg = sMsg & vbCrLf & _
    lErrOrg & " error(s) in the 'Org Value'"
    If lErrText > 0 Then _
    sMsg = sMsg & vbCrLf & _
    lErrText & " 'SubC'(s) Value are not 'Text'"
    If lErrValue > 0 Then _
    sMsg = sMsg & vbCrLf & _
    lErrValue & " error(s) in the 'SubC Value's"
    End If
    MsgBox sMsg
    Set rCell = Nothing
    Set rng = Nothing
    End Sub</pre>


    Steve

  4. #4
    3 Star Lounger
    Join Date
    May 2002
    Location
    Mpls, Minnesota, USA
    Posts
    271
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Check cells for valid (Excel 2003)

    Legare and Steve,
    I copied both macros and pasted into a text file. Then from there to the module. For some reason I still had to fix the "<" from <
    But, I got both debugged and they both worked GREAT. I thank you both, along with the entire Lounge, for all the work that is saved for soooo many people.

    Thank You.
    Chuck
    Chuck Reimer
    I'm from the Government and I'm here to help...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •