Currently I am using the code below on a daily basis having column a checking column be for a match. Now I need to expand this code to check columns b,c and d, How do I code this without repeating the same code over again for each column. Each colmn will go from row 2 to 121,since there are headers in the first row of each of these columns.
Private Sub FindMissingNumber()
Dim rng As Excel.Range
Dim booFound As Boolean
Dim c As Object
Dim i As Integer
Dim j As Integer
Dim booShowMessage As Boolean
'Dim rngMissing As Excel.Range
Set rng = Sheets("Inventory").Range("a:a")
booShowMessage = False
'Set rngMissing = Sheets("Compare").Range("e:e")
j = 1
i = 2
Do Until rng.Cells(i, 1).Value = 0
booFound = False
For Each c In Sheets("Inventory").[b:b]
If c.Value = 0 Or c.Value = vbNullString Then
Exit For
End If
If c.Value = rng.Cells(i, 1).Value Then
booFound = True
Exit For
End If
Next c
If booFound = False Then
'If j = 1 Then
' rngMissing.Cells(j, 1).Value = "MISSING"
'End If
'j = j + 1
' rngMissing.Cells(j, 1).Value = rng.Cells(i, 1).Value
booShowMessage = True
rng.Cells(i, 1).Font.Color = RGB(255, 0, 0)
rng.Cells(i, 1).Font.Bold = True
' Else
' rng.Cells(i, 1).Font.Color = 0
' rng.Cells(i, 1).Font.Bold = False
End If
i = i + 1
Loop
If booShowMessage = True Then
MsgBox "Missing tapes are marked red in column A", vbInformation, "Missing Tapes"
End If
End Sub
Private Sub FindMissingNumber()
Dim rng As Excel.Range
Dim booFound As Boolean
Dim c As Object
Dim i As Integer
Dim j As Integer
Dim booShowMessage As Boolean
'Dim rngMissing As Excel.Range
Set rng = Sheets("Inventory").Range("a:a")
booShowMessage = False
'Set rngMissing = Sheets("Compare").Range("e:e")
j = 1
i = 2
Do Until rng.Cells(i, 1).Value = 0
booFound = False
For Each c In Sheets("Inventory").[b:b]
If c.Value = 0 Or c.Value = vbNullString Then
Exit For
End If
If c.Value = rng.Cells(i, 1).Value Then
booFound = True
Exit For
End If
Next c
If booFound = False Then
'If j = 1 Then
' rngMissing.Cells(j, 1).Value = "MISSING"
'End If
'j = j + 1
' rngMissing.Cells(j, 1).Value = rng.Cells(i, 1).Value
booShowMessage = True
rng.Cells(i, 1).Font.Color = RGB(255, 0, 0)
rng.Cells(i, 1).Font.Bold = True
' Else
' rng.Cells(i, 1).Font.Color = 0
' rng.Cells(i, 1).Font.Bold = False
End If
i = i + 1
Loop
If booShowMessage = True Then
MsgBox "Missing tapes are marked red in column A", vbInformation, "Missing Tapes"
End If
End Sub