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
Is this correct 1 million rows?
To be exact 5lakh rows in macro excel
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
With that amount of data it is going to be slow.
Can you try Conditional Formatting
I need to test with 8 different sheets and need to add one more column at end if difference means yes and if no difference means no and can we apply conditional formatting through macro ?
The reason I suggested Conditional Formatting was to avoid a slow macro.
I am new to this and my client is asking with one click different in all the sheets as sheet1vsSheet2 and sheet2vs Sheet1 and so on up sheet7 vs sheet 8 and sheet8 vs Sheet7 if its some what slow also it's is ok I need to give to the client not for my using, please help me thanks
Hi, i attached the excel sheet with macro codes please check it out
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
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 Subremoved 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 SubThat code, and probably any other code, will take a long time with your amount of data.
I'm not sure what you mean by your client, but if someone is employing you to this then you really shouldn't have take the job.
I am processing my client data as above given excel and store the value and give to client if it's slow also ok but it shouldn't hange can you please help me regarding it
I don't know how long this will take
Option Explicit
Sub Compare2Sheets()
Dim vSheet1 As Variant, vSheet2 As Variant
Dim lRw As Long, lCol As Long
vSheet1 = Worksheets("Sheet1").UsedRange
vSheet2 = Worksheets("Sheet2").UsedRange
For lRw = LBound(vSheet1, 1) To UBound(vSheet1, 1)
For lCol = LBound(vSheet1, 2) To UBound(vSheet1, 2)
If vSheet1(lRw, lCol) = vSheet2(lRw, lCol) Then
''/// Cells are identical so do nothing.
Else
' Cells are different.
Cells(lRw, lCol).Interior.ColorIndex = 6
End If
Next lCol
Next lRw
End SubPlace the code in a Standard module. Change the sheet names to the ones that you use
If row is not available means above code will work ?
I don't know what you mean. The code compares the cells on two sheets, e.g. if A1 is different on each sheet then A1 on the active sheet is coloured yellow.
But code I gave is different can you please correct the code I gave so that it doesn't hange thanks in advance
I've no idea what your code is doing and it's using Find to find cells which will take forever.
I'm still not sure what you want to do are you comparing cell to cell?
First cell from A1 need to found in second sheet if not found we will colour entire row and. If row is found in second sheet we need to compare both the columns for difference if found we need to color the cell which is different in active sheet
Do you mean that the value in A1 is somewhere in sheet 2, not necessarily in A1?
Don’t have an account yet? Register yourself now and be a part of our community!