Macro to force format and check barcode check digit

Hi,

My company uses 4 types of barcodes 8, 12, 13, & 14 number barcodes for our products my problem is that I can't figure out how to force the barcode to format properly no matter how somebody enters it if they don't use spaces or put them in the wrong spots, I can't use custom formats because there is 4 different layouts

8 digit should be "#### ####"
12 digit should be "###### ######"
13 digit should be "# ###### ######"
14 digit should be "# ## ##### ######"

these barcodes are in columns L, M, & N also right now 'm using a formula in another cell to verify the barcodes by calculating the check digit and comparing it to the check digit typed the formula i'm using is

=IF(LEN(L2)=13,EXACT(--RIGHT(ABS((MOD((((MID(L2,1,1)+MID(L2,3,1)+MID(L2,5,1)+MID(L2,8,1)+MID(L2,10,1)+MID(L2,12,1))*3)+(MID(L2,2,1)+MID(L2,4,1)+MID(L2,6,1)+MID(L2,9,1)+MID(L2,11,1))),10)-10)),1),RIGHT(L2,1))

,IF(LEN(L2)=17,EXACT(--RIGHT(ABS((MOD((((MID(L2,1,1)+MID(L2,4,1)+MID(L2,7,1)+MID(L2,9,1)+MID(L2,12,1)+MID(L2,14,1)+MID(L2,16,1))*3)+(MID(L2,3,1)+MID(L2,6,1)+MID(L2,8,1)+MID(L2,10,1)+MID(L2,13,1)+MID(L2,15,1))),10)-10)),1),RIGHT(L2,1))

,IF(LEN(L2)=15,EXACT(--RIGHT(ABS((MOD((((MID(L2,3,1)+MID(L2,5,1)+MID(L2,7,1)+MID(L2,10,1)+MID(L2,12,1)+MID(L2,14,1))*3)+(MID(L2,1,1)+MID(L2,4,1)+MID(L2,6,1)+MID(L2,8,1)+MID(L2,11,1)+MID(L2,13,1))),10)-10)),1),RIGHT(L2,1))

,IF(LEN(L2)=9,EXACT((ROUNDUP(((MID(L2,1,1)+MID(L2,3,1)+MID(L2,6,1)+MID(L2,8,1))*3)+(MID(L2,2,1)+MID(L2,4,1)+MID(L2,7,1)),-1))-(((MID(L2,1,1)+MID(L2,3,1)+MID(L2,6,1)+MID(L2,8,1))*3)+(MID(L2,2,1)+MID(L2,4,1)+MID(L2,7,1))),RIGHT(L2,1))

,(LEN(L2)<4)))))

I have that cell change to red if the check digits don't match, but i would prefer to have the cell with the upc change the fill to red if it is typed incorrectly but i don't know how to write the formula in vba. I'd want the macro to run whenever the cell contents are changed. any help would be much appreciated, i'm pretty new to VBA and I just can't figure this one out
or find out how to do it on the net.

Thanks,

Chris

Maybe like this, assuming none of the barcodes have leading zeros. Code goes in the Sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r           As Range
    Dim cell        As Range

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

    For Each cell In r
        Select Case r.Value
            Case 10000000 To 99999999
                cell.NumberFormat = "#### ####"
                cell.Interior.ColorIndex = xlColorIndexNone
            
            Case 100000000000# To 999999999999#
                cell.NumberFormat = "###### ######"
                cell.Interior.ColorIndex = xlColorIndexNone
            
            Case 1000000000000# To 9999999999999#
                cell.NumberFormat = "# ###### ######"
                cell.Interior.ColorIndex = xlColorIndexNone
            
            Case 10000000000000# To 99999999999999#
                cell.NumberFormat = "# ## ##### ######"
                cell.Interior.ColorIndex = xlColorIndexNone
            
            Case Else
                cell.Interior.ColorIndex = 3
        End Select
    Next cell
End Sub

Adding Code to a Sheet module
1. Copy the code from the post
2. Right-click on the tab for the relevant sheet and select View Code. This opens the Visual Basic Editor (VBE) and shows the object module for the selected worksheet.
3. Paste the code in the window
4. Press Alt+Q to close the VBE and return to Excel

It would be easy enough to add the check digit processing if you explain the algorithm (or provide a link) so I don't have to dissect your formula.

Maybe like this. I confess to minimal testing. Format columns L:M as text beforehand.

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
            If VarType(.Value) = vbString Then
                s = Replace(.Text, " ", "")
            End If
            
            If Not IsNumeric(s) Then
                .Interior.ColorIndex = 3
                Exit Sub
            End If

            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 000000 000000")
                    .Interior.ColorIndex = xlColorIndexNone

                Case Else
                    .Interior.ColorIndex = 3
            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
                iSum = WorksheetFunction.Ceiling(iSum, 10) Mod 10 - iSum
                If iSum=10 Then iSum = 0
                If Val(Right(s, 1)) <> iSum Then .Interior.ColorIndex = 3
            End If
        End With
        
    Next cell

Oops:
    Application.EnableEvents = True
End Sub

Post a workbook and explain how to break it.

Bug in the code; try this:

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 = 3
            
            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
                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 iformatting 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

BTW, the conditional formatting you're using for alternate line shading will override the cell color applied in the code.