overide conditional formatting with VBA

**Code Flunkie** · 03-10-2010, 05:58 PM

I have a macro that checks a barcode to see if it a valid barcode. if it isn't it makes the cell red to show there is an error. this all works great except that I use conditional formatting to color band every second row to make the data stand out because there is over 3000 lines in the spreadsheet. my problem is that while the if an error occurs where there is no color it is fine but if there is color it hides the error color so the error doesn't show. is there a way around the conditional formatting either by doing the color banding with VBA or to makeconditional formatting's priority lower. any help would be much appreciated. i've included the code i use below.

Thanks in advance,

Chris

Code:

=MOD(ROW(),2)=1

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

LastRow = ActiveSheet.UsedRange.Rows.Count

        With Target
          
          If .Count > 1 Then Exit Sub
            If Not Intersect(Range("L2:L4000"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                   .Offset(0, 5).ClearContents
                Else
                    With .Offset(0, 5)
                        .NumberFormat = "mm/dd/yyyy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
          
          If .Count > 1 Then Exit Sub
            If Not Intersect(Range("M2:M4000"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                   .Offset(0, 5).ClearContents
                Else
                    With .Offset(0, 4)
                        .NumberFormat = "mm/dd/yyyy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If

          If .Count > 1 Then Exit Sub
            If Not Intersect(Range("N2:N4000"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                   .Offset(0, 4).ClearContents
                Else
                    With .Offset(0, 3)
                        .NumberFormat = "mm/dd/yyyy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
            
        End With
'    End Sub
    
'Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r           As Range
    Dim cell        As Range
    Dim s           As String
    Dim i           As Long
    Dim iSum        As Long

    Set r = Intersect(Target, Columns("L:N"))
    If r Is Nothing Then Exit Sub

    On Error GoTo Oops
    Application.EnableEvents = False

    For Each cell In r
        With cell
            s = Replace(.Text, " ", "")

            If Not IsNumeric(s) Then
                .Interior.ColorIndex = xlColorIndexNone
            
            Else
                Select Case Len(s)
                    Case 8
                        .Value = Format(Val(s), "0000 0000")
                        .Interior.ColorIndex = xlColorIndexNone

                    Case 12
                        .Value = Format(Val(s), "000000 000000")
                        .Interior.ColorIndex = xlColorIndexNone

                    Case 13
                        .Value = Format(Val(s), "0 000000 000000")
                        .Interior.ColorIndex = xlColorIndexNone

                    Case 14
                        .Value = Format(Val(s), "0 00 00000 000000")
                        .Interior.ColorIndex = xlColorIndexNone

                    Case Else
                        .Interior.ColorIndex = 3
                         MsgBox "Not a valid UPC Format"
                End Select

                If .Interior.ColorIndex = xlColorIndexNone Then
                    iSum = 0
                    For i = 1 To Len(s) - 1
                        iSum = iSum + Val(Mid(s, i, 1)) * IIf(i And 1, 3, 1)
                    Next i 'formatting in the code.
                    iSum = WorksheetFunction.Ceiling(iSum, 10) - iSum
                    If Val(Right(s, 1)) <> iSum Then .Interior.ColorIndex = 3
                End If
            End If
        End With
    Next cell

Oops:
    Application.EnableEvents = True
End Sub

**shg** · 03-10-2010, 06:11 PM

You could create a simple UDF to return true for a valid barcode based on length and checksum, and add that to the existing conditional formatting.

**Code Flunkie** · 03-11-2010, 09:45 AM

I'm pretty new to VBA, so how would i do that?

**shg** · 03-12-2010, 03:57 PM

Change the code in the sheet module to this:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim r           As Range
    Dim cell        As Range
    Dim s           As String
    Dim i           As Long
    Dim iSum        As Long     ' checksum
    Dim sFmt        As String   ' barcode format string

    Set r = Intersect(Target, Me.Columns("L:N"), Me.UsedRange)
    If r Is Nothing Then Exit Sub

    On Error GoTo Oops
    Application.EnableEvents = False

    For Each cell In r
        With cell
            Select Case cell.Column
                Case 12
                    If IsEmpty(.Value) Then
                        .Offset(0, 5).ClearContents
                    Else
                        With .Offset(0, 5)
                            .NumberFormat = "mm/dd/yyyy"
                            .Value = Date
                        End With
                    End If

                Case 13
                    If IsEmpty(.Value) Then
                        .Offset(0, 5).ClearContents
                    Else
                        With .Offset(0, 4)
                            .NumberFormat = "mm/dd/yyyy"
                            .Value = Date
                        End With
                    End If

                Case 14
                    If IsEmpty(.Value) Then
                        .Offset(0, 4).ClearContents
                    Else
                        With .Offset(0, 3)
                            .NumberFormat = "mm/dd/yyyy"
                            .Value = Date
                        End With
                    End If
            End Select

            .NumberFormat = BarcodeFormat(.Text)
        End With
    Next cell

Oops:
    Application.EnableEvents = True
End Sub

Then put this in a code module:

Code:

Option Explicit

Function IsValidChecksum(ByVal sInp As String) As Boolean
    Dim i           As Long
    Dim iSum        As Long


    sInp = Replace(sInp, " ", "")
    If IsNumeric(sInp) Then

        For i = 1 To Len(sInp) - 1
            iSum = iSum + Val(Mid(sInp, i, 1)) * IIf(i And 1, 3, 1)
        Next i
        iSum = WorksheetFunction.Ceiling(iSum, 10) - iSum

        IsValidChecksum = Val(Right(sInp, 1)) = iSum
    End If
End Function

Function BarcodeFormat(sInp As String) As String
    sInp = Replace(sInp, " ", "")

    If Not IsNumeric(sInp) Then
        BarcodeFormat = "@"

    Else
        Select Case Len(sInp)
            Case 8: BarcodeFormat = "0000 0000"
            Case 12: BarcodeFormat = "000000 000000"
            Case 13: BarcodeFormat = "0 000000 000000"
            Case 14: BarcodeFormat = "0 00 00000 000000"
            Case Else: BarcodeFormat = "0"
        End Select
    End If
End Function

Then select A1 on Sheet1 and do Insert > Name > Define

Sheet1!Me Refers to:=A1

frmChkBad Refers to: =NOT(IsValidChecksum(Sheet1!Me))

Then select the relevant portions of columns L/M/N, and do Format > Conditional Formatting,

Formula is =frmChkBad and format as red

You can integrate the color banding after you get all that straight.

**Code Flunkie** · 03-12-2010, 05:37 PM

I'm having issues with:

Then select A1 on Sheet1 and do Insert > Name > Define

Sheet1!Me Refers to:=A1

frmChkBad Refers to: =NOT(IsValidChecksum(Sheet1!Me))

Then select the relevant portions of columns L/M/N, and do Format > Conditional Formatting,

Formula is =frmChkBad and format as red

i'm using Office 2007 so i went formulas>defined names> define names but it giving me an error when i try to put in it says it's not a valid name. what am i doing wrong