Comparing two columns with VBA, inserting blank rows moving associated data

[Saria Ahmad]

Hi folks, I am quite new to VBA. I need help in comparing the data in two columns. I want to bring similar data in same row and if nothing common is found I want to insert the blank row. I tried many ways but all in vain.
sample data file is attached below
Below is my code.
Looking forward for your valuable suggestions.


Sub compare()
Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Range("A1:A11")
Set rng2 = Range("B1:B8")

If rng1.Value1 = rng2.Value2 Then
'both cells dont match.'
Else
Worksheets(1).Rows(1).Insert
End If
End Sub

 

[Saria Ahmad]

In looking at your sample data in column O, it looks like there are multiple records with the same value.
Not having a unique 1-1 match complicates things greatly.
I am not sure what you expect/want to do with that situation.

Quite frankly, I think this is going to be a bit messy in Excel.
If it were me, I would import (or link) both lists into Microsoft Access, and do some Matched and Unmatched queries between the two lists, i.e.
1. One query to return the matching records between the the two lists (though duplicate records could still be problematic here)
2. One query to return the unmatched records from list 1 not in list 2
3. One query to return the unmatched records from list 2 not in list 1

That is also a nice idea. But for now can you please just share the idea of writing the VBA code according to what I explain to you? Afterwards, I will see what would be nicer ideas.

 

[Joe4]

That is also a nice idea. But for now can you please just share the idea of writing the VBA code according to what I explain to you? Afterwards, I will see what would be nicer ideas.

You haven't addressed the issue of the duplicate entries in the second list, and how that is to be handled.
Without knowing what you want to do with that, I really cannot recommend anything.

 

[Saria Ahmad]

You haven't addressed the issue of the duplicate entries in the second list, and how that is to be handled.
Without knowing what you want to do with that, I really cannot recommend anything.

Hey Joe. This excel sheet is some how complicated for applying Vba code. Could you please share your valuable suggestions ( regarding vba code) on the the sample data file (image1) which I have shared with you? because in some other excel sheets there are no duplicates found as in the last shared one.

 

[Joe4]

My idea is to sort each list, in ascending order, independently of one another.
Then compare each line, and if they match, fine. If not, you will need to insert a blank cell in one of the lists, and then continue on.

 

[Joe4]

I took the data from your first image, and populated it starting in cells H8 and O8, per your other instructions, and then create code that would do the comparion you wanted.
Here is the code:

Sub MyCompareMacro()

    Dim lr1 As Long
    Dim lr2 As Long
    Dim rng1 As Range
    Dim rng2 As Range
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column H
    lr1 = Cells(Rows.Count, "H").End(xlUp).Row

'   Create rng1
    Set rng1 = Range("H8:H" & lr1)
    
'   Find last row with data in column O
    lr2 = Cells(Rows.Count, "O").End(xlUp).Row

'   Create rng2
    Set rng2 = Range("O8:O" & lr2)
    
'   Sort rng1
    rng1.Sort key1:=Range("H8"), order1:=xlAscending, Header:=xlNo
        
'   Sort rng2
    rng2.Sort key1:=Range("O8"), order1:=xlAscending, Header:=xlNo
    
'   Loop through all rows and compare data
    r = 8
    Do
    
'       If both columns H and O are blank, exit loop
        If Cells(r, "H") = "" And Cells(r, "O") = "" Then Exit Do
        
'       If both cells have values, compare them
        If Cells(r, "H") <> "" And Cells(r, "O") <> "" Then
'           Check to see if the value in H is less than the value in O
            If Cells(r, "H") < Cells(r, "O") Then
'               Insert a blank cell in column O
                Cells(r, "O").Insert Shift:=xlDown
            Else
'               Check to see if the value in H is greater than the value in O
                If Cells(r, "H") > Cells(r, "O") Then
'                   Insert a blank cell in column H
                    Cells(r, "H").Insert Shift:=xlDown
                End If
            End If
        End If
        
'       Add one to row counter
        r = r + 1
        
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro Complete!"
    
End Sub

I added lots of comments to explain what the code is doing along the way.

 

[Saria Ahmad]

I took the data from your first image, and populated it starting in cells H8 and O8, per your other instructions, and then create code that would do the comparion you wanted.
Here is the code:

Sub MyCompareMacro()

    Dim lr1 As Long
    Dim lr2 As Long
    Dim rng1 As Range
    Dim rng2 As Range
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column H
    lr1 = Cells(Rows.Count, "H").End(xlUp).Row

'   Create rng1
    Set rng1 = Range("H8:H" & lr1)
   
'   Find last row with data in column O
    lr2 = Cells(Rows.Count, "O").End(xlUp).Row

'   Create rng2
    Set rng2 = Range("O8:O" & lr2)
   
'   Sort rng1
    rng1.Sort key1:=Range("H8"), order1:=xlAscending, Header:=xlNo
       
'   Sort rng2
    rng2.Sort key1:=Range("O8"), order1:=xlAscending, Header:=xlNo
   
'   Loop through all rows and compare data
    r = 8
    Do
   
'       If both columns H and O are blank, exit loop
        If Cells(r, "H") = "" And Cells(r, "O") = "" Then Exit Do
       
'       If both cells have values, compare them
        If Cells(r, "H") <> "" And Cells(r, "O") <> "" Then
'           Check to see if the value in H is less than the value in O
            If Cells(r, "H") < Cells(r, "O") Then
'               Insert a blank cell in column O
                Cells(r, "O").Insert Shift:=xlDown
            Else
'               Check to see if the value in H is greater than the value in O
                If Cells(r, "H") > Cells(r, "O") Then
'                   Insert a blank cell in column H
                    Cells(r, "H").Insert Shift:=xlDown
                End If
            End If
        End If
       
'       Add one to row counter
        r = r + 1
       
    Loop
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro Complete!"
   
End Sub

I added lots of comments to explain what the code is doing along the way.

Thanks for the code. can you please explain a bit?

 

[Saria Ahmad]

I took the data from your first image, and populated it starting in cells H8 and O8, per your other instructions, and then create code that would do the comparion you wanted.
Here is the code:

Sub MyCompareMacro()

    Dim lr1 As Long
    Dim lr2 As Long
    Dim rng1 As Range
    Dim rng2 As Range
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column H
    lr1 = Cells(Rows.Count, "H").End(xlUp).Row

'   Create rng1
    Set rng1 = Range("H8:H" & lr1)
   
'   Find last row with data in column O
    lr2 = Cells(Rows.Count, "O").End(xlUp).Row

'   Create rng2
    Set rng2 = Range("O8:O" & lr2)
   
'   Sort rng1
    rng1.Sort key1:=Range("H8"), order1:=xlAscending, Header:=xlNo
       
'   Sort rng2
    rng2.Sort key1:=Range("O8"), order1:=xlAscending, Header:=xlNo
   
'   Loop through all rows and compare data
    r = 8
    Do
   
'       If both columns H and O are blank, exit loop
        If Cells(r, "H") = "" And Cells(r, "O") = "" Then Exit Do
       
'       If both cells have values, compare them
        If Cells(r, "H") <> "" And Cells(r, "O") <> "" Then
'           Check to see if the value in H is less than the value in O
            If Cells(r, "H") < Cells(r, "O") Then
'               Insert a blank cell in column O
                Cells(r, "O").Insert Shift:=xlDown
            Else
'               Check to see if the value in H is greater than the value in O
                If Cells(r, "H") > Cells(r, "O") Then
'                   Insert a blank cell in column H
                    Cells(r, "H").Insert Shift:=xlDown
                End If
            End If
        End If
       
'       Add one to row counter
        r = r + 1
       
    Loop
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro Complete!"
   
End Sub

I added lots of comments to explain what the code is doing along the way.

Thanks alot, It quite helpful. One think I dont understand in the is lr1 and lr2. What are they? and what are their purpose. Please explain it in few words.

 

[Saria Ahmad]

I took the data from your first image, and populated it starting in cells H8 and O8, per your other instructions, and then create code that would do the comparion you wanted.
Here is the code:

Sub MyCompareMacro()

    Dim lr1 As Long
    Dim lr2 As Long
    Dim rng1 As Range
    Dim rng2 As Range
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column H
    lr1 = Cells(Rows.Count, "H").End(xlUp).Row

'   Create rng1
    Set rng1 = Range("H8:H" & lr1)
   
'   Find last row with data in column O
    lr2 = Cells(Rows.Count, "O").End(xlUp).Row

'   Create rng2
    Set rng2 = Range("O8:O" & lr2)
   
'   Sort rng1
    rng1.Sort key1:=Range("H8"), order1:=xlAscending, Header:=xlNo
       
'   Sort rng2
    rng2.Sort key1:=Range("O8"), order1:=xlAscending, Header:=xlNo
   
'   Loop through all rows and compare data
    r = 8
    Do
   
'       If both columns H and O are blank, exit loop
        If Cells(r, "H") = "" And Cells(r, "O") = "" Then Exit Do
       
'       If both cells have values, compare them
        If Cells(r, "H") <> "" And Cells(r, "O") <> "" Then
'           Check to see if the value in H is less than the value in O
            If Cells(r, "H") < Cells(r, "O") Then
'               Insert a blank cell in column O
                Cells(r, "O").Insert Shift:=xlDown
            Else
'               Check to see if the value in H is greater than the value in O
                If Cells(r, "H") > Cells(r, "O") Then
'                   Insert a blank cell in column H
                    Cells(r, "H").Insert Shift:=xlDown
                End If
            End If
        End If
       
'       Add one to row counter
        r = r + 1
       
    Loop
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro Complete!"
   
End Sub

I added lots of comments to explain what the code is doing along the way.

Its Quite clear, I just go through it again. You dont need to explain it more

 

[Joe4]

Sorry, for some reason I did not get notifications of your earlier replies.
Yes, I added comments to my code to try to explain what each part does.

Glad you figured it out.

 

[Saria Ahmad]

Hi, Yes this is the simplified example. I am attaching the glimpse of the data. Here the I only need to compare column H and O and the comparison should begin from H8 and O8. Cell alignment(similar text in both columns should be on the same row and if no text found I want to insert a blank row) is what I need.

Hi, could you help me in writing vba code for this sort of data. Idea behind dealing with this kind of data is to make one reference column, bring data on the same line(row). insert a blank line instead. For instance. I have 5 columns to compare with each other and with among 5 column I want to assign one reference column and compare the rest 4 columns with the reference column 1 by 1. If duplicates occur in the same column just appear as it is