Macro to classify the rows as "In Correct" if different student having same Communication details

[Manish_Gupta]

Dear Experts,

I am looking for a Macro which classify the rows as "In Correct" in Column E if different student (student name mentioned in Column A) having same Communication (Mobile, Email or Address) details mentioned in subsequent columns.

The data size in excel is huge currently approx. 90k rows. Column E should enter as "In Correct" in case of any single match found (either Email or Mobile or Address)

Data is like:
Column A - Student Name, Column B - Email Id, Column C - Address, Column D - Mobile

Apologies for not providing any sample data as I am facing some concerns with my system right now.

Thanks for your help,

 

[Legacy 143009]

Which one should be checked:
- Duplicate students in the list with different contact details
Or
- One student for example, entered his email address to the Address column also?

 

[Manish_Gupta]

Hello Flashbond,
Thanks for the quick revert.

Macro should check different student having same contact details.
To make it more accurate I have changed the data in Column A from Name to Roll No.

Example:

Roll No.	Email	Address	Mobile	Remarks
101	abc@gmail.com*	123, Delhi	111111111
102	abc@gmail.com*	345, Gurgaon	123456789	In Correct as duplicate entry matched with Roll no. 101
103	xyz@yahoo.com	-	-
104	-	-	123456789	In Correct as duplicate entry matched with Roll no. 102
101	abc@gmail.com	123, Delhi	111111111	This will not mentioned as In Correct as Roll No. is same.

I know it is quite a tricky but that is what we have to identify.

Please let me know in case of any other clarity required.

Thanks

 

[Legacy 143009]

This will work for you:

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  
  For i = 2 To lRow
    For j = 2 To i - 1
      If Cells(i, 1).Value <> Cells(j, 1).Value Then
        For c = 2 To 4
          If Cells(i, c).Value <> "-" And Cells(j, c).Value <> "-" And Cells(i, c).Value = Cells(j, c).Value Then
            Cells(i, 5).Value = "Same " & Cells(1, c).Value & " information with " & Cells(j, 1).Value
          End If
        Next
      End If
    Next
  Next
End Sub

 

[Manish_Gupta]

Hello Flashbond,

I had tried the macro on few rows data and I believe the output was totally fine. Thank you so much for your help for this solution.

I am trying to run this macro on full database which contains 90k rows but the macro is getting hanged or may be taking too long time in response. Can we do anything in code to run it fast on these kind of huge database.

Thanks

 

[Legacy 143009]

Sorry, this is the best I can do. Maybe you should leave the file open for a night. Or wait for other suggestions.

Option Explicit
Sub test()
  Dim lRow As Long, i As Long, j As Long
  Dim c As Integer
  Dim students() As Variant
  Dim results() As Variant

  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  ReDim results(lRow - 1)
  students = Range("A1:D" & lRow).Value
 
  For i = 2 To lRow
    found = False
    For j = 2 To lRow
      If students(i, 1) = students(j, 1) Then GoTo skipStudent
      For c = 1 To 4
        If students(j, c) = "-" Or students(i, c) <> "-" Then GoTo skipColumn
        If students(i, c) = students(j, c) Then
          results(i - 1) = results(i - 1) & "Same " & students(1, c) & " information with " & students(j, 1) & vbCrLf
        End If
skipColumn:
        Next
skipStudent:
    Next
  Next
 
  Application.ScreenUpdating = False
  For i = 2 To lRow
    Cells(i, 5).Value = results(i - 1)
  Next
  Application.ScreenUpdating = True

End Sub

 

[Manish_Gupta]

Sorry, this is the best I can do. Maybe you should leave the file open for a night. Or wait for other suggestions.

Option Explicit
Sub test()
  Dim lRow As Long, i As Long, j As Long
  Dim c As Integer
  Dim students() As Variant
  Dim results() As Variant

  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  ReDim results(lRow - 1)
  students = Range("A1:D" & lRow).Value
 
  For i = 2 To lRow
    found = False
    For j = 2 To lRow
      If students(i, 1) = students(j, 1) Then GoTo skipStudent
      For c = 1 To 4
        If students(j, c) = "-" Or students(i, c) <> "-" Then GoTo skipColumn
        If students(i, c) = students(j, c) Then
          results(i - 1) = results(i - 1) & "Same " & students(1, c) & " information with " & students(j, 1) & vbCrLf
        End If
skipColumn:
        Next
skipStudent:
    Next
  Next
 
  Application.ScreenUpdating = False
  For i = 2 To lRow
    Cells(i, 5).Value = results(i - 1)
  Next
  Application.ScreenUpdating = True

End Sub

Thank you so much Flashbond for your help. Appreciate a lot.