Compare Cell Value between 2 range of cells

[vadius]

Hello guys

I have two sheets : the first one contains all the source data, the second one contains some of those data.
I want to build a macro that compares the values of the first four cells in each row of sheet(1) with those of sheets (2) and if equal, then copies the entire row of sheets(2) into a sheet(3), else copies the entire row of sheets(1) into sheet(3).

The rationale behind is the following : Data from sheet(1) are updated automatically from an independant database, and in sheet(2) I change manually some of the values (But I keep the values of the first four cells of each row so that I compare). Sheet(3) combines both.

Below my macro : I don't know how to specify the range of cells to compare between sheet(1) and sheet(2) neither how to ask the macro compare those values. If equal then copy the entire row...

Below Worksheets("Index_Div_Source") is sheet(1) and Worksheets("Index_Div_Manual") is sheet(2) . Sourcecel are the first four cells of each row in the sheet(1) and manualcel the first four cell of each row in sheet(3). Worksheets("Index_Div_Final") is sheet(3) where I want to combine everything.

Hope it's clear,

Thanks you

Sub Compare()

Dim i As Integer
Dim manualcel As Range
Dim sourcecel As Range

Dim lastrow As Integer

Application.ScreenUpdating = False

lastrow = Worksheets("Index_Div_Source").Range("A65536").End(xlUp).Row


With Worksheets("Index_Div_Final")

For i = 3 To lastrow

Set manualcel = Worksheets("Index_Div_Manual").Range("A" & i, "D" & i)

For Each sourcecel In Worksheets("Index_Div_Source").Range("A" & i, "D" & i)

If sourcecel.Value = manualcel.Value Then

Worksheets("Index_Div_Manual").Range("A" & i).EntireRow.Copy
Worksheets("Index_Div_Final").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Else

Worksheets("Index_Div_Source").Range("A" & i).EntireRow.Copy
Worksheets("Index_Div_Final").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End If

Next

Application.ScreenUpdating = True

Next

End With


End Sub

 

[venkat1926]

this is a hybrid solution

sample data in sheet no. 1 and sheet no.2 with the names of sheets are as follows ( see the formula in E2 in both sheets which are copied down)

Excel Workbook
	A	B	C	D	E
1	hdng1	hdng2	hdng3	hdng4
2	a	2	99	46	a29946
3	s	43	8	47	s43847
4	d	47	57	97	d475797
5	f	98	89	53	f988953
6	g	81	1	70	g81170
7	h	3	72	77	h37277
Index_Div_Source

Excel Workbook
	A	B	C	D	E
1	hdng1	hdng2	hdng3	hdng4
2	a	2	99	46	a29946
3	d	47	57	97	d475797
4	g	81	1	70	g81170
5	k	5	6	7	k567
Index_Div_Manual

after fillilng formulas in column E in both sheets try this macro

Sub test()
Dim r As Range, c As Range, cfind As Range, x As String
With Worksheets("index_div_source")
Set r = Range(.Range("E2"), .Range("E2").End(xlDown))
For Each c In r
x = c.Value
With Worksheets("Index_Div_Manual")
Set cfind = .Cells.Find(what:=x, lookat:=xlWhole, LookIn:=xlValues)
If Not cfind Is Nothing Then
cfind.EntireRow.Copy
Else
GoTo nextc
End If
With Worksheets("sheet3")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
End With
nextc:
Next c
End With

End Sub

Sub undo()
Worksheets("sheet3").Cells.Clear
End Sub

 

[vadius]

Hi

Thanks for posting this.
I am actually looking for a way to compare the first four cells of each row from sheet(1) with the first four cells of the rows of sheet(2).
Somekind of vlookup but instead of looking for one value, I am looking at four values at one time . If found somewhere in the table, copy and paste the whole row into sheet(3). Otherwise, copy fron sheet(1) into sheet(3).

Thanks

 

[venkat1926]

this is one way of solving what you want. instead of comparing each one of the four cells in a row you concatenate the four cells in the row in one cell (column E) and compare this column in both sheets. see the formula in E2 in both sheets which are copied down. study the solution carefully.

 

[vadius]

It is actually not doing it. It effectively compares Index_Div_Source with Index_Div_Manual and copy into sheet3 when found. But I want it to copy the line of Source_Div when it does not find the values in Index_Div_Manual. Thanks

 

[venkat1926]

I have modified marginally now check

Sub test()
Dim r As Range, c As Range, cfind As Range, x As String
With Worksheets("index_div_source")
Set r = Range(.Range("E2"), .Range("E2").End(xlDown))
For Each c In r
x = c.Value
With Worksheets("Index_Div_Manual")
Set cfind = .Cells.Find(what:=x, lookat:=xlWhole, LookIn:=xlValues)
If cfind Is Nothing Then
c.EntireRow.Copy
Else
GoTo nextc
End If
With Worksheets("sheet3")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
End With
nextc:
Next c
End With

End Sub

 

[vadius]

Seems to be working now when I launch both macros subsequentely
Thanks!