Macro to check for data and note absence

[laniw75]

I am hoping to sap some of the brilliant minds that frequent this forum. I need a macro that will check a column for specific numbers and report a number that is missing in a specific cell. I.e. (Check for 1,2,3,4, if 3 is missing put a 3 in cell A50), I also need it to check for double ups (i.e. each number must be unique for that column). Any advice?

 

[pbornemeier]

For the first part: What specific numbers are you checking for? Are they always integers? Supposed to be in order? Always start with 1? Always end in 4? Please be more specific on your requirements for this.

For the second part: You can use this formula (confirmed with Control-Shift-Enter) to count the unique items in a range (Range_List), then compare that number with the COUNTA value for the same range.

=SUM(IF(FREQUENCY(IF(Range_List<>"",MATCH("~"&Range_List,Range_List&"",0)),ROW(Range_List)-ROW(Sheet1!$A$1)+1),1))

 

[laniw75]

Thanks for your help, Phil. The numbers I need to check are 1,2,3,4,5,6,11,12,13,14,15,16, 20 & 21 and they do not need to be in order. To give you some background, these numbers connect to a roster which I use another macro to build.

 

[pbornemeier]

Here is 1 way to see the results. Copy C2 down to C15

Sheet1

<table style="font-family: Arial,Arial; font-size: 10pt; background-color: rgb(255, 255, 255); padding-left: 2pt; padding-right: 2pt;" border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="width: 30px;"><col style="width: 107px;"><col style="width: 64px;"><col style="width: 64px;"></colgroup><tbody><tr style="background-color: rgb(202, 202, 202); text-align: center; font-size: 8pt;"><td> </td><td>A</td><td>B</td><td>C</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">1</td><td>Checked Column</td><td>Ref</td><td>Count</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">2</td><td style="text-align: right;">14</td><td style="text-align: right;">1</td><td style="text-align: right;">0</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">3</td><td style="text-align: right;">20</td><td style="text-align: right;">2</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">4</td><td style="text-align: right;">5</td><td style="text-align: right;">3</td><td style="text-align: right;">0</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">5</td><td style="text-align: right;">12</td><td style="text-align: right;">4</td><td style="text-align: right;">0</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">6</td><td style="text-align: right;">20</td><td style="text-align: right;">5</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">7</td><td style="text-align: right;">6</td><td style="text-align: right;">6</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">8</td><td style="text-align: right;">16</td><td style="text-align: right;">11</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">9</td><td style="text-align: right;">16</td><td style="text-align: right;">12</td><td style="text-align: right;">2</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">10</td><td style="text-align: right;">2</td><td style="text-align: right;">13</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">11</td><td style="text-align: right;">19</td><td style="text-align: right;">14</td><td style="text-align: right;">1</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">12</td><td style="text-align: right;">12</td><td style="text-align: right;">15</td><td style="text-align: right;">0</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">13</td><td style="text-align: right;">21</td><td style="text-align: right;">16</td><td style="text-align: right;">2</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">14</td><td style="text-align: right;">13</td><td style="text-align: right;">20</td><td style="text-align: right;">2</td></tr><tr style="height: 17px;"><td style="font-size: 8pt; background-color: rgb(202, 202, 202); text-align: center;">15</td><td style="text-align: right;">11</td><td style="text-align: right;">21</td><td style="text-align: right;">1</td></tr></tbody></table>
<table style="font-family: Arial; font-size: 10pt; border-style: groove; border-color: rgb(0, 255, 0); background-color: rgb(255, 252, 249); color: rgb(0, 0, 0);"><tbody><tr><td>Spreadsheet Formulas</td></tr><tr><td><table style="font-family: Arial; font-size: 9pt;" border="1" cellpadding="2" cellspacing="0"><tbody><tr style="background-color: rgb(202, 202, 202); font-size: 10pt;"><td>Cell</td><td>Formula</td></tr><tr><td>C2</td><td>=COUNTIF(A:A,"=" &B2)</td></tr></tbody></table></td></tr></tbody></table>
Excel tables to the web - Excel Jeanie Html 4

 

[pbornemeier]

You will have to mod this a bit, but it gives you the vectors you asked for:

Option Explicit
Sub CompareRangeToArrayFindMissingAndDupes()
    Dim aInput As Variant
    Dim lX As Long
    Dim b As Variant
    Dim vKey As Variant
    Dim sMissing As String
    Dim sDupes As String
 
    aInput = Array(1, 2, 3, 4, 5, 6, 11, 12, 13, 14, 15, 16, 20, 21)
    ReDim b(1 To UBound(aInput, 1) + 1, 1 To 1)
 
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For lX = 0 To UBound(aInput, 1) 'Load keys, set item = 0
            .Item(aInput(lX)) = 0
        Next
 
        Sheets("sheet1").Range("d2").Resize(UBound(b, 1)).Value = Application.Transpose(.keys)
        Sheets("sheet1").Range("e2").Resize(UBound(b, 1)).Value = Application.Transpose(.items)
 
 
        With Sheets("sheet1") 'Load input range to array
            aInput = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value
        End With
 
        For lX = 1 To UBound(aInput, 1) 'Increment dictionary item values
            If .exists(aInput(lX, 1)) Then
                .Item(aInput(lX, 1)) = .Item(aInput(lX, 1)) + 1
            End If
        Next
 
        Sheets("sheet1").Range("i2").Resize(UBound(b, 1)).Value = Application.Transpose(.keys)
        Sheets("sheet1").Range("j2").Resize(UBound(b, 1)).Value = Application.Transpose(.items)
 
        For Each vKey In .keys
            Debug.Print vKey, .Item(vKey), IsMissing(.Item(vKey)), IsEmpty(.Item(vKey))
            If .Item(vKey) = 0 Then
                sMissing = sMissing & vKey & ", "
            End If
            If .Item(vKey) > 1 Then
                sDupes = sDupes & vKey & ", "
            End If
        Next
        If Len(sMissing) > 2 Then sMissing = Left(sMissing, Len(sMissing) - 2)
        If Len(sDupes) > 2 Then sDupes = Left(sDupes, Len(sDupes) - 2)
        Range("B49").Value = "Missing:"
        Range("B50").Value = sMissing
        Range("B52").Value = "Dupes:"
        Range("B53").Value = sDupes
 
    End With
End Sub

 

[laniw75]

Phil, I will give this a bash. Thank you so much for the time and effort you have put into creating this for me.