CODEWITHSUNDEEP
excelvbaexcel-formulacompare
btwolfe
btwolfe

Reputation: 25

How to compare values in two sheets and list missing values in a third sheet

I am looking for a formula or VBA code for my custom Check-Out and Check-In in Excel.
In my first sheet, I have a four-column table that will include hundreds of values. Across the four columns there will be values entered as "Name #", "Phone 1" or "Bodycam 1" and so on.
At a later time, my second sheet will contain these values in one column.

There is a chance that some values are missing between the two. I would like to display the missing values in one column of my third sheet.

To better sum things up, I want to compare columns C-F in 'Sheet 1' to column C in 'Sheet 2'.
If there are matching values, then nothing needs to take place.
If 'Sheet 2' has missing values I want to display the missing values on 'Sheet 3'.

I tried a few formulas, but I have not been able to find one that works in multiple sheets.

For example:
I have five values that have been checked-in compared to the total of fourteen checked out.
I want the nine values that did not get checked back in to be listed in the third sheet.

CHECK-OUT
enter image description here

CHECK-IN
enter image description here

NOT RETURNED
enter image description here

Upvotes: 2

Views: 806

Answers (1)

VBasic2008
VBasic2008

Reputation: 54853

A VBA Lookup: Retrieve Missing Values

enter image description here

Sub RetrieveMissingValues()
    
    ' Lookup
    Const LKP_SHEET As String = "CHECK-IN"
    Const LKP_FIRST_CELL As String = "C2"
    ' Source
    Const SRC_SHEET As String = "CHECK-OUT"
    Const SRC_FIRST_ROW As String = "C2:F2"
    ' Destination
    Const DST_SHEET As String = "NOT RETURNED"
    Const DST_FIRST_CELL As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim lws As Worksheet: Set lws = wb.Sheets(LKP_SHEET)
    If lws.FilterMode Then lws.ShowAllData
    
    Dim lData(), lrCount As Long
    
    With lws.Range(LKP_FIRST_CELL)
        Dim llCell As Range: Set llCell = .Resize(lws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If llCell Is Nothing Then Exit Sub
        lrCount = llCell.Row - .Row + 1
        If lrCount = 1 Then
            ReDim lData(1 To 1, 1 To 1): lData(1, 1) = .Value
        Else
            lData = .Resize(lrCount).Value
        End If
    End With
    
    Dim lDict As Object: Set lDict = CreateObject("Scripting.Dictionary")
    lDict.CompareMode = vbTextCompare
    
    Dim lr As Long, lStr As String
    
    For lr = 1 To lrCount
        lStr = CStr(lData(lr, 1))
        If Len(lStr) > 0 Then
            If Not lDict.Exists(lStr) Then
                lDict(lStr) = Empty
            End If
        End If
    Next lr
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
    If sws.FilterMode Then sws.ShowAllData
    
    Dim sData(), srCount As Long, scCount As Long
    
    With sws.Range(SRC_FIRST_ROW)
        Dim slCell As Range: Set slCell = .Resize(sws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If slCell Is Nothing Then Exit Sub
        srCount = slCell.Row - .Row + 1
        scCount = .Columns.Count
        sData = .Resize(srCount).Value
    End With
     
    Dim dData(): ReDim dData(1 To srCount * scCount, 1 To 1)
     
    Dim sr As Long, sc As Long, dr As Long, sStr As String
    
    For sr = 1 To srCount
        For sc = 1 To scCount
            sStr = CStr(sData(sr, sc))
            If Len(sStr) > 0 Then
                If Not lDict.Exists(sStr) Then
                    dr = dr + 1
                    dData(dr, 1) = sData(sr, sc)
                End If
            End If
        Next sc
    Next sr
    
    If dr = 0 Then
        MsgBox "No missing values found.", vbInformation
        Exit Sub
    End If
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    With dws.Range(DST_FIRST_CELL)
        .Resize(dr).Value = dData
        .Resize(dws.Rows.Count - .Row - dr + 1).Offset(dr).Clear
    End With
    
    MsgBox "Missing values retrieved.", vbInformation
    
End Sub

Upvotes: 2

Related Questions