Identify inconsistency

[OCM]

Hi,

I’ve three excel worksheets that I combined, sorted to identify inconsistency. Given the same value in the ID field, the expected result in the date of birth field should be the same. The goal is to filter out where the date of birth is inconsistence. Currently, I leveraged the pivot table to identify these records. But, when the dataset is huge, the task can be very time consuming.


Please see attached file and the expected result.

ID#	Last Name	First Initial	Date of Birth
566639	CHENOWETH	A	10/19/2023
566639	CHENOWETH	A	10/19/2023
566639	CHENOWETH	A	10/19/2023
4017088	SMITH	P	6/26/2023	*	* eyeballing to find inconsistency
4017088	SMITH	P	7/11/2022	*
4017088	SMITH	p	6/26/2023	*
5885404	HARRIS	I	11/24/2023	*		expected result
5885404	HARRIS	I	11/30/2023	*		ID#	Last Name	First Initial	Date of Birth
5885404	HARRIS	I	12/6/2023	*		4017088	SMITH	P	6/26/2023
6567610	BOYD	B	9/21/2023			4017088	SMITH	P	7/11/2022
6567610	BOYD	B	9/21/2023			4017088	SMITH	p	6/26/2023
6567610	BOYD	B	9/21/2023			5885404	HARRIS	I	11/24/2023
8884616	HAMLET	A	11/24/2023	*		5885404	HARRIS	I	11/30/2023
8884616	HAMLET	A	11/23/2023	*		5885404	HARRIS	I	12/6/2023
13362760	BLOUNT	C	9/24/2023			8884616	HAMLET	A	11/24/2023
13362760	BLOUNT	C	9/24/2023			8884616	HAMLET	A	11/23/2023
13362760	BLOUNT	C	9/24/2023
60406540	WADE	D	9/16/2023
60406540	WADE	D	9/16/2023
60406540	WADE	D	9/16/2023
70277960	SMITH	E	9/30/2023
70277960	SMITH	E	9/30/2023

TIA



Regards,

 

[KRice]

Welcome to the MrExcel board! What version of Excel are you using? You can update your profile to show that...important as the version often factors into the approaches that might be considered.

 

[StephenCrump]

Welcome to the Forum!

Further to Kevin's question, please put this in your Account Details as we have both done, for future reference.

You could test like this. And then use the FILTER function if you have the latest version of Excel.

	A	B	C	D	E	F
1	ID#	Last Name	First Initial	Date of Birth
2	566639	CHENOWETH	A	10/19/2023		FALSE
3	566639	CHENOWETH	A	10/19/2023		FALSE
4	566639	CHENOWETH	A	10/19/2023		FALSE
5	4017088	SMITH	P	6/26/2023	*	TRUE
6	4017088	SMITH	P	7/11/2022	*	TRUE
7	4017088	SMITH	p	6/26/2023	*	TRUE
8	5885404	HARRIS	I	11/24/2023	*	TRUE
9	5885404	HARRIS	I	11/30/2023	*	TRUE
10	5885404	HARRIS	I	12/06/2023	*	TRUE
11	6567610	BOYD	B	9/21/2023		FALSE
12	6567610	BOYD	B	9/21/2023		FALSE
13	6567610	BOYD	B	9/21/2023		FALSE
14	8884616	HAMLET	A	11/24/2023	*	TRUE
15	8884616	HAMLET	A	11/23/2023	*	TRUE
16	13362760	BLOUNT	C	9/24/2023		FALSE
17	13362760	BLOUNT	C	9/24/2023		FALSE
18	13362760	BLOUNT	C	9/24/2023		FALSE
19	60406540	WADE	D	9/16/2023		FALSE
20	60406540	WADE	D	9/16/2023		FALSE
21	60406540	WADE	D	9/16/2023		FALSE
22	70277960	SMITH	E	9/30/2023		FALSE
23	70277960	SMITH	E	9/30/2023		FALSE
Sheet1

Cell Formulas
Range	Formula
F2:F23	F2	=COUNTIFS(A$2:A$23,A2,D$2:D$23,D2)<>COUNTIF(A$2:A$23,A2)

 

[CephasOz]

If you want a VBA solution, you could try this:

Sub CheckBirthDates()
    Const clngIdCol As Long = 1
    Const clngBDCol As Long = 4
    Const clngMarkCol As Long = 5
    Const clngFirstDataRow As Long = 2
    Const cstrAsterisk As String = "*"
    '
    Dim lngRow As Long
    Dim lngLastRow As Long
    Dim lngReportRow As Long
    Dim dblId As Double
    Dim dblPrevId As Double
    Dim datDateOfBirth As Date
    Dim datPrevDateOfBirth As Date
    Dim strDupes As String
    Dim wksData As Worksheet
    Dim wksReport As Worksheet
    Dim bolBadDate As Boolean
    '
    Set wksData = ActiveSheet
    Set wksReport = ThisWorkbook.Worksheets.Add(After:=wksData)
    wksReport.Rows(1).Value = wksData.Rows(1).Value
    lngReportRow = 1
    dblPrevId = 0
    datPrevDateOfBirth = 0
    With wksData
        lngLastRow = .Cells(1).CurrentRegion.Rows.CountLarge
        For lngRow = clngFirstDataRow To lngLastRow
            dblId = .Cells(lngRow, clngIdCol).Value
            datDateOfBirth = .Cells(lngRow, clngBDCol).Value
            If (dblId = dblPrevId) Then
                If (datDateOfBirth <> datPrevDateOfBirth) Then
                    bolBadDate = True
                End If
            Else
                bolBadDate = False
            End If
            If bolBadDate Then
                lngReportRow = lngReportRow + 1
                ' Copy previous record
                If (.Cells(lngRow - 1, clngMarkCol).Value <> cstrAsterisk) Then
                    .Range(.Cells(lngRow - 1, clngIdCol), .Cells(lngRow - 1, clngBDCol)).Copy _
                        Destination:=wksReport.Cells(lngReportRow, clngIdCol).Resize(1, clngBDCol)
                    .Cells(lngRow - 1, clngMarkCol).Value = cstrAsterisk
                    lngReportRow = lngReportRow + 1
                End If
                ' Copy current record
                .Range(.Cells(lngRow, clngIdCol), .Cells(lngRow, clngBDCol)).Copy _
                    Destination:=wksReport.Cells(lngReportRow, clngIdCol).Resize(1, clngBDCol)
                .Cells(lngRow, clngMarkCol).Value = cstrAsterisk
            End If
            dblPrevId = dblId
            datPrevDateOfBirth = datDateOfBirth
        Next
    End With
End Sub

 

[OCM]

Thank you everyone for your feedback.

I’m using office 365, and as you suggested I updated this information. Also, I attempted to use XL2BB tool to post sample without any success. This may be because I use work laptop and we are not allowed to download and/or use any ad-ins.​

The solution provided by StephenCrump worked perfectly and produced the expected result.

CephasOz, I execute your code: “Alt + F11" to access the VBA editor and selected the macro/code and clicked “run/F5”. I didn’t get the expected result. I noticed two excel worksheet were created (screenshot attached).

My dataset varies month to month, sometimes it is 2000 rows, sometimes 10,000+ rows. My VBA knowledge is limited. Does your solution work regardless of the # of records?

Also, while researching a solution for something similar, power query was mentioned. Since, I’m not familiar with power query, I’d like to get your feedback on this subject.​

​

Regards,

 

[CephasOz]

Since what @StephenCrump has provided meets your needs, you're okay.
For my code, I noticed that it wouldn't pick up a situation where a set of three id's were the same, but only the first two birthdates were the same. So I re-wrote it so that it doesn't matter how many id's are the same, and will check the birthdates of them all (revised code below). The code will process all of your rows, no matter how many there are. You don't really need the second sheet which lists the non-matching duplicates since they are marked on the original sheet, so that second sheet can be removed from the code if you don't want it.

Sub CheckBirthDates()
    Const clngIdCol As Long = 1
    Const clngBDCol As Long = 4
    Const clngMarkCol As Long = 5
    Const clngFirstDataRow As Long = 2
    Const cstrAsterisk As String = "*"
    '
    Dim lngRow As Long
    Dim lngLastRow As Long
    Dim lngReportRow As Long
    Dim lngOffset As Long
    Dim lngCntr As Long
    Dim rngID As Range
    Dim rngBD As Range
    Dim wksData As Worksheet
    Dim wksReport As Worksheet
    Dim bolBadDate As Boolean
    '
    Set wksData = ActiveSheet
    Set wksReport = ThisWorkbook.Worksheets.Add(After:=wksData)
    wksReport.Rows(1).Value = wksData.Rows(1).Value
    lngReportRow = 1
    With wksData
        lngLastRow = .Cells(1).CurrentRegion.Rows.CountLarge
        For lngRow = clngFirstDataRow To lngLastRow
            Set rngID = .Cells(lngRow, clngIdCol)
            Set rngBD = .Cells(lngRow, clngBDCol)
            .Cells(lngRow, clngMarkCol).ClearContents
            lngOffset = 0
            bolBadDate = False
            Do While ((lngRow + lngOffset + 1) <= lngLastRow) And (rngID.Value = rngID.Offset(lngOffset + 1).Value)
                If (rngBD.Value <> rngBD.Offset(lngOffset + 1).Value) Then
                    bolBadDate = True
                End If
                lngOffset = lngOffset + 1
            Loop
            If bolBadDate Then
                For lngCntr = 0 To lngOffset
                    lngReportRow = lngReportRow + 1
                    .Range(.Cells(lngRow + lngCntr, clngIdCol), .Cells(lngRow + lngCntr, clngBDCol)).Copy _
                        Destination:=wksReport.Cells(lngReportRow, clngIdCol).Resize(1, clngBDCol)
                    .Cells(lngRow + lngCntr, clngMarkCol).Value = cstrAsterisk
                Next
                lngRow = lngRow + lngOffset
            End If
        Next lngRow
    End With
End Sub

 

[OCM]

Great, thank you for the updated code.

Thank you everyone for your feedback and solutions.

Regards,