How to compare two columns in excel, inserting blank rows moving associated data
Category: [Excel] Demo Available
How to compare two columns in excel, inserting blank rows moving associated data
Requirement:
The user has two lists each list has few columns and wants to match first list first column with second list first column and if they are not matching cells from each list insert blank line. For example:
| List1 | List2 | Final result | |||||||||||
| 11111 | abc | hello | 11111 | abc | 120 | 11111 | abc | hello | 11111 | abc | 120 | ||
| 11112 | bcd | hi | 11113 | cdd | 120 | 11112 | bcd | hi | |||||
| 11114 | ecd | right | 11114 | ecd | 120 | 11113 | cdd | 120 | |||||
| 11115 | dde | wrong | 11116 | dff | 120 | 11114 | ecd | right | 11114 | ecd | 120 | ||
| 11117 | edfd | cell | 11117 | edfd | 120 | 11115 | dde | wrong | |||||
| 11118 | drek | 120 | 11116 | dff | 120 | ||||||||
| 11117 | edfd | cell | 11117 | edfd | 120 | ||||||||
| 11118 | drek | 120 | |||||||||||
Solution:
Code:
Sub MatchColumns_Bis()
'First List Starts from A10 and ends at J10 (talking about first rows)
'Second List starts from L10 and ends W10 (talking about first rows)
'would like to paste in Y10.
Set coll = New Collection
ur1 = Cells(Rows.Count, 1).End(xlUp).Row
ur2 = Cells(Rows.Count, 12).End(xlUp).Row
Range("Y10:AX3000").ClearContents 'changed
On Error Resume Next
For i = 10 To ur1 'changed
coll.Add Cells(i, 1).Value, CStr(Cells(i, 1))
Next i
For i = 10 To ur2 'changed
coll.Add Cells(i, 12).Value, CStr(Cells(i, 12))
Next i
On Error GoTo 0
ReDim ordina(1 To coll.Count)
For i = 1 To coll.Count
ordina(i) = coll(i)
Next i
For i = 1 To UBound(ordina) - 1
For j = i + 1 To UBound(ordina)
If ordina(i) > ordina(j) Then
temp = ordina(i)
ordina(i) = ordina(j)
ordina(j) = temp
End If
Next j
Next i
a = 9 'changed
For j = 1 To UBound(ordina)
flg = 0
For i = 10 To ur1 'changed
If ordina(j) = Cells(i, 1) Then
a = a + 1: flg = 1
Range(Cells(i, 1), Cells(i, 10)).Copy Cells(a, 25)
End If
Next i
If flg = 0 Then a = a + 1
Next j
a = 9 'changed
For j = 1 To UBound(ordina)
flg = 0
For i = 10 To ur2 'changed
If ordina(j) = Cells(i, 12) Then
a = a + 1: flg = 1
Range(Cells(i, 12), Cells(i, 23)).Copy Cells(a, 36)
End If
Next i
If flg = 0 Then a = a + 1
Next j
End Sub
Obtained from the OzGrid Help Forum.
Solution provided by Marius44.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to use a single 'date field' for various items in a data entry userform |
| How to create data entry userforms |
| How to add rows and specific text after changes in data |
| How to use a macro to copy data from multiple workbooks to one master sheet in another workbook |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.