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

Saria Ahmad

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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
 

Attachments

  • Annotation 2021-02-23 122257.png
    Annotation 2021-02-23 122257.png
    27.4 KB · Views: 8

Saria Ahmad

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,744
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,744
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,744
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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:
VBA 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.
 
Solution

Saria Ahmad

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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:
VBA 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

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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:
VBA 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

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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:
VBA 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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,744
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 23, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,128,129
Messages
5,628,869
Members
416,347
Latest member
AT2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top