Posts by revanth









Code
Display Moreremoved few lines Private Sub multmatch(ByVal Sheet1 As String, ByVal Sheet2 As String) Dim cell As range Dim found As range Dim r1 As range, r2 As range, ws1 As Worksheet, ws2 As Worksheet Dim s As String Dim c As Long Dim b, h As Boolean, v(), i As Long, wf As WorksheetFunction Dim e As Long Set wf = WorksheetFunction Set ws1 = Sheets(Sheet2) With ws1 Set r1 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With e = ws1.UsedRange.Columns.Count Set ws2 = Sheets(Sheet1) With ws2 Set r2 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With ws1.range("A1").CurrentRegion.Offset(2).Interior.Color = xlNone For Each cell In r1 Set found = r2.Find(cell, LookAt:=xlWhole) If found Is Nothing Then cell.Resize(, e).Interior.ColorIndex = 45 cell.Offset(, e  1).Value = "Yes" Else ReDim v(1 To 2, 1 To 2) s = found.Address b = True i = i + 1 v(i, 1) = cell.Address v(i, 2) = found.Address End If Set found = r2.FindNext(found) If b Then For i = LBound(v, 1) To UBound(v, 1) With ws1 If Not IsEmpty(v(i, 1)) Then .range(v(i, 1)).Resize(, e).Interior.Color = xlNone .range(v(i, 1)).Offset(, e  1).Value = "No" For c = 0 To e  2 If .range(v(i, 1)).Offset(, c) <> ws2.range(v(i, 2)).Offset(, c) Then .range(v(i, 1)).Offset(, c).Interior.Color = vbRed .range(v(i, 1)).Offset(, e  1).Value = "Yes" End If Next c End If End With Next i End If End If b = False i = 0 Next cell End Sub

Code
Display MorePrivate Sub multmatch(ByVal Sheet1 As String, ByVal Sheet2 As String) Dim cell As range Dim found As range Dim r1 As range, r2 As range, ws1 As Worksheet, ws2 As Worksheet Dim s As String Dim c As Long Dim b, h As Boolean, v(), i As Long, wf As WorksheetFunction Dim e As Long Set wf = WorksheetFunction Set ws1 = Sheets(Sheet2) With ws1 Set r1 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With e = ws1.UsedRange.Columns.Count Set ws2 = Sheets(Sheet1) With ws2 Set r2 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With ws1.range("A1").CurrentRegion.Offset(2).Interior.Color = xlNone For Each cell In r1 Set found = r2.Find(cell, LookAt:=xlWhole) If found Is Nothing Then cell.Resize(, e).Interior.ColorIndex = 45 cell.Offset(, e  1).Value = "Yes" Else ReDim v(1 To 2, 1 To 2) s = found.Address 'Do 'If cell.Offset(, 3) = found.Offset(0, 3) And _ 'cell.Offset(, 4) = found.Offset(0, 4) And _ 'cell.Offset(, 6) = found.Offset(0, 6) Then b = True i = i + 1 v(i, 1) = cell.Address v(i, 2) = found.Address 'End If Set found = r2.FindNext(found) 'Loop While found.Address <> s If b Then For i = LBound(v, 1) To UBound(v, 1) With ws1 If Not IsEmpty(v(i, 1)) Then .range(v(i, 1)).Resize(, e).Interior.Color = xlNone .range(v(i, 1)).Offset(, e  1).Value = "No" For c = 0 To e  2 If .range(v(i, 1)).Offset(, c) <> ws2.range(v(i, 2)).Offset(, c) Then .range(v(i, 1)).Offset(, c).Interior.Color = vbRed .range(v(i, 1)).Offset(, e  1).Value = "Yes" End If Next c End If End With Next i End If End If b = False i = 0 Next cell End Sub Private Sub multmatch(ByVal Sheet1 As String, ByVal Sheet2 As String) Dim cell As range Dim found As range Dim r1 As range, r2 As range, ws1 As Worksheet, ws2 As Worksheet Dim s As String Dim c As Long Dim b, h As Boolean, v(), i As Long, wf As WorksheetFunction Dim e As Long Set wf = WorksheetFunction Set ws1 = Sheets(Sheet2) With ws1 Set r1 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With e = ws1.UsedRange.Columns.Count Set ws2 = Sheets(Sheet1) With ws2 Set r2 = .range("A2", .range("A" & Rows.Count).End(xlUp)) End With ws1.range("A1").CurrentRegion.Offset(2).Interior.Color = xlNone For Each cell In r1 Set found = r2.Find(cell, LookAt:=xlWhole) If found Is Nothing Then cell.Resize(, e).Interior.ColorIndex = 45 cell.Offset(, e  1).Value = "Yes" Else ReDim v(1 To 2, 1 To 2) s = found.Address 'Do 'If cell.Offset(, 3) = found.Offset(0, 3) And _ 'cell.Offset(, 4) = found.Offset(0, 4) And _ 'cell.Offset(, 6) = found.Offset(0, 6) Then b = True i = i + 1 v(i, 1) = cell.Address v(i, 2) = found.Address 'End If Set found = r2.FindNext(found) 'Loop While found.Address <> s If b Then For i = LBound(v, 1) To UBound(v, 1) With ws1 If Not IsEmpty(v(i, 1)) Then .range(v(i, 1)).Resize(, e).Interior.Color = xlNone .range(v(i, 1)).Offset(, e  1).Value = "No" For c = 0 To e  2 If .range(v(i, 1)).Offset(, c) <> ws2.range(v(i, 2)).Offset(, c) Then .range(v(i, 1)).Offset(, c).Interior.Color = vbRed .range(v(i, 1)).Offset(, e  1).Value = "Yes" End If Next c End If End With Next i End If End If b = False i = 0 Next cell End Sub




What I need is to compare 2sheets in same excel with half million rows(5laks) and with 50colums in both the sheet and colour the cell if different in first sheet and colour if row is not present and I tried comparison code from this website it worked for low rows and for hug data it is hanging and iam new to this can please help me


i am trying to compare 2 sheets with builk rows and 50 columns and highlights the difference in each column of a rows and if that rows is not present we would highlights that row also and and adding one more column at last if difference we will print yes else no can you please help me Ex 1 million rows are needed
and 50 columns in both tables