For Loop

[CyndyG]

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

 

[Sharkie21]

Not exactly sure how you're checks are supposed to work inside the loop because they are looking a specific fields. So not sure if B,C,D all verify with the same fields as A would.

However, what you want to do is add a for loop outside it all and make it loop through the columns A,B,C,D. This inner loop which you currently have needs to be robust enough so you can take in the current column you're looking at instead of just A.

 

[Scott Huish]

What is this code supposed to do exactly?

 

[acw]

Hi

I think this is what you are trying to achieve.

Sub bbb()
 Missing = False
 For Each ce In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
  If ce <> ce.Offset(0, 1) Or ce <> ce.Offset(0, 2) Or ce <> ce.Offset(0, 3) Then
   ce.Font.Color = RGB(255, 0, 0)
   ce.Font.Bold = True
   Missing = True
  End If
 Next ce

 If Missing Then
  MsgBox "Missing tapes are marked red in column A", vbInformation, "Missing Tapes"
 End If
End Sub

Tony

 

[CyndyG]

If column B had the same number as column A then they would match, If column C had the match ,then coumn B wouldn't have the match.

Well I can't explain this to make you understand what is going on. I will try something else.

 

[acw]

CyndyG

Which of the 4 columns would have the highlighted entry when a match was not found? My interpretation of your message output and code is that column A would be highlighted if there as a comparable entry missing in any of B, C or D.


Tony

 

[CyndyG]

Yes that is correct. This is an Inventory program that has benn used since March,I am just expanding.
Column A represents the range of tapes assigned.
Coumn B reprsents the tapes that are actually in the library.
But some of the tapes in column B may not match with Column A because they may have been sent out.
Column C is a list of the tapes that have been sent out,so they should match what it is in column A. Then the missing button is clicked that will highlight Column A for the ones that are still missing, If missing is found then the operator scans in the missing in column D,which would then match in Column A. The missing button is clicked again, Column A is no longer highligted in red because all missing have been found. Inventory is complete

 

[tusharm]

Minimally tested.

Option Explicit

    Function foundInList(val, aList As Range) As Boolean
        Dim x
        On Error Resume Next
        x = Application.WorksheetFunction.Match(val, aList, 0)
        foundInList = Err.Number = 0
        End Function
    Function setRange(StartCell As Range) As Range
        If IsEmpty(StartCell.Value) Then
            Set setRange = Nothing
        ElseIf IsEmpty(StartCell.Offset(1, 0).Value) Then
            Set setRange = StartCell
        Else
            Set setRange = Range(StartCell, StartCell.End(xlDown))
            End If
        End Function
    
Sub checkInventory()
    Dim AllTapes As Range, LibraryTapes As Range, _
        CheckedOutTapes As Range, MissingTapes As Range, _
        aCell As Range, MissingTapeCount As Long
    With ActiveSheet
    Set AllTapes = setRange(.Range("a1"))
    Set LibraryTapes = setRange(.Range("b1"))
    Set CheckedOutTapes = setRange(.Range("c1"))
    Set MissingTapes = setRange(.Range("d1"))
        End With
    AllTapes.Font.ColorIndex = 1
    AllTapes.Font.Bold = False
    For Each aCell In AllTapes
        If foundInList(aCell.Value, LibraryTapes) Then
        ElseIf foundInList(aCell.Value, CheckedOutTapes) Then
        ElseIf foundInList(aCell.Value, MissingTapes) Then
        Else
            aCell.Font.Color = RGB(255, 0, 0)
            aCell.Font.Bold = True
            MissingTapeCount = MissingTapeCount + 1
            End If
        Next aCell
    If MissingTapeCount > 0 Then
        MsgBox MissingTapeCount & " tape" & IIf(MissingTapeCount > 1, "s", "") _
            & " missing!"
    Else
        MsgBox "All tapes accounted for!"
        End If
    End Sub

Edit 1: Tweaked the position of the 'End With' statement.
Edit 2: Tweaked grammar of warning message.

Yes that is correct. This is an Inventory program that has benn used since March,I am just expanding.
Column A represents the range of tapes assigned.
Coumn B reprsents the tapes that are actually in the library.
But some of the tapes in column B may not match with Column A because they may have been sent out.
Column C is a list of the tapes that have been sent out,so they should match what it is in column A. Then the missing button is clicked that will highlight Column A for the ones that are still missing, If missing is found then the operator scans in the missing in column D,which would then match in Column A. The missing button is clicked again, Column A is no longer highligted in red because all missing have been found. Inventory is complete

 

[CyndyG]

Thank You