VBA : Compare, matching and offset set of data

G

greenbubble

New Member
Joined
Nov 13, 2022
Messages
7
Office Version
  1. 2003 or older
Hi,
Currently im using below VBA that is found in excel forum and its working fine for less data. I tried to run the VBA
for more than 2000 row of data it take some time to complete or most of the time it will crashed.

1 have 2 set of data:
1st set (Col:A,B,C,D)
2nd set Col:E,F,G,H)

I need to compare col A with col E data vise versa, matching by offset either 1st set or 2nd set.
i try to search for the solution and stuck with it. I expect help from you for my problem

Sub compare_c ()

Dim oLeft As Range
Dim oRight As Range

Set oLeft = Sheets("Summary").Range("A1,B1,C1,D1")
Set oRight = Sheets("Summary").Range("E1,F1,G1,H1")

Do Until oLeft.Value = "" Or oRight.Value = ""

If oLeft.Value = oRight.Value Then
Set oLeft = oLeft.Offset(1, 0)
Set oRight = oRight.Offset(1, 0)
ElseIf oLeft.Value > oRight.Value Then
oLeft.Insert Shift:=xlShiftDown
Set oRight = oLeft.Offset(0, 4)
Else
oRight.Insert Shift:=xlShiftDown
Set oLeft = oRight.Offset(0, -4)
End If
Loop

End Sub


mrExcel1.jpg
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Try the following on a copy of your data

Option Explicit
VBA Code: 
Sub greenbubble()
    Application.ScreenUpdating = 0
    Application.Calculation = xlManual
    Dim Ws As Worksheet
    Set Ws = Worksheets("Summary")
    Dim LRow As Long, i As Long, j As Long
    LRow = Ws.Cells(Rows.Count, 1).End(3).Row
    
    For i = LRow To 1 Step -1
        j = WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1))
            If j > 1 Then
                Ws.Cells(i, 1).Offset(1).Resize(j - 1, 4).Insert xlDown
            End If
    Next i
    
    LRow = Ws.Cells(Rows.Count, 1).End(3).Row
    For i = 1 To LRow
        If Ws.Cells(i, 1) <> "" Then
        j = WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1))
            If j = 0 Then
                Ws.Cells(i, 1).Offset(, 4).Resize(, 4).Insert xlDown
            End If
        End If
    Next i
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = 1
End Sub
 
Upvote 0
greenbubble said:
it mess up at row 629
Click to expand...
It's strange that it should suddenly fail at that particular row. I can't tell much from an image, I'd like to fix the problem but I'll need you to provide a copy of the sheet using the XL2BB add in, or perhaps you can share the file using DropBox or something similar?
 
Upvote 0
Proxxx1.xlsm
ABCDEFGH
141000117-Oct-2022abdsafa14100017-Oct-20221abdsafa1
2410002217-Oct-2022saepuno141000217-Oct-20222saepuno1
3410003325-Oct-2022abdsafa141000325-Oct-20223abdsafa1
4410004418-Oct-2022MAZLAAH241000418-Oct-20224MAZLAAH2
5410005529-Oct-2022MAZLAAH24100066-Oct-20226abdsafa1
641000666-Oct-2022abdsafa141000722-Oct-20227MAZLAAH2
7410007722-Oct-2022MAZLAAH241000828-Oct-20228MAZLAAH2
841000998-Oct-2022MAZLAAH24100098-Oct-20229MAZLAAH2
94100101016-Oct-2022MAZLAAH241001016-Oct-202210MAZLAAH2
104100111117-Oct-2022MAZLAAH241001117-Oct-202211MAZLAAH2
11410012121-Oct-2022abdsafa14100121-Oct-202212abdsafa1
124100131316-Oct-2022abdsafa141001316-Oct-202213abdsafa1
134100141421-Oct-2022MAZLAAH241001421-Oct-202214MAZLAAH2
144100151522-Oct-2022MAZLAAH241001522-Oct-202215MAZLAAH2
154100161611-Oct-2022MAZLAAH241001611-Oct-202216MAZLAAH2
164100171720-Oct-2022saepuno141001720-Oct-202217saepuno1
17410018189-Oct-2022abdsafa14100189-Oct-202218abdsafa1
184100191924-Oct-2022saepuno141001924-Oct-202219saepuno1
194100212112-Oct-2022abdsafa14100204-Oct-202220abdsafa1
204100222217-Oct-2022saepuno141002217-Oct-202222saepuno1
214100232321-Oct-2022MAZLAAH241002321-Oct-202223MAZLAAH2
224100242427-Oct-2022MAZLAAH241002427-Oct-202224MAZLAAH2
23410025253-Oct-2022abdsafa14100253-Oct-202225abdsafa1
244100262618-Oct-2022MAZLAAH241002618-Oct-202226MAZLAAH2
254100272724-Oct-2022saepuno141002724-Oct-202227saepuno1
26410028287-Oct-2022abdsafa14100287-Oct-202228abdsafa1
27410029297-Oct-2022MAZLAAH24100297-Oct-202229MAZLAAH2
284100303017-Oct-2022MAZLAAH241003017-Oct-202230MAZLAAH2
294100313118-Oct-2022MAZLAAH241003118-Oct-202231MAZLAAH2
304100323223-Oct-2022saepuno141003223-Oct-202232saepuno1
314100333331-Oct-2022abdsafa141003331-Oct-202233abdsafa1
32410034348-Oct-2022MAZLAAH24100348-Oct-202234MAZLAAH2
3341003517-Oct-202235MAZLAAH2
Summary2
 
Upvote 0
greenbubble said:
Proxxx1.xlsm
ABCDEFGH
141000117-Oct-2022abdsafa14100017-Oct-20221abdsafa1
2410002217-Oct-2022saepuno141000217-Oct-20222saepuno1
3410003325-Oct-2022abdsafa141000325-Oct-20223abdsafa1
4410004418-Oct-2022MAZLAAH241000418-Oct-20224MAZLAAH2
5410005529-Oct-2022MAZLAAH24100066-Oct-20226abdsafa1
641000666-Oct-2022abdsafa141000722-Oct-20227MAZLAAH2
7410007722-Oct-2022MAZLAAH241000828-Oct-20228MAZLAAH2
841000998-Oct-2022MAZLAAH24100098-Oct-20229MAZLAAH2
94100101016-Oct-2022MAZLAAH241001016-Oct-202210MAZLAAH2
104100111117-Oct-2022MAZLAAH241001117-Oct-202211MAZLAAH2
11410012121-Oct-2022abdsafa14100121-Oct-202212abdsafa1
124100131316-Oct-2022abdsafa141001316-Oct-202213abdsafa1
134100141421-Oct-2022MAZLAAH241001421-Oct-202214MAZLAAH2
144100151522-Oct-2022MAZLAAH241001522-Oct-202215MAZLAAH2
154100161611-Oct-2022MAZLAAH241001611-Oct-202216MAZLAAH2
164100171720-Oct-2022saepuno141001720-Oct-202217saepuno1
17410018189-Oct-2022abdsafa14100189-Oct-202218abdsafa1
184100191924-Oct-2022saepuno141001924-Oct-202219saepuno1
194100212112-Oct-2022abdsafa14100204-Oct-202220abdsafa1
204100222217-Oct-2022saepuno141002217-Oct-202222saepuno1
214100232321-Oct-2022MAZLAAH241002321-Oct-202223MAZLAAH2
224100242427-Oct-2022MAZLAAH241002427-Oct-202224MAZLAAH2
23410025253-Oct-2022abdsafa14100253-Oct-202225abdsafa1
244100262618-Oct-2022MAZLAAH241002618-Oct-202226MAZLAAH2
254100272724-Oct-2022saepuno141002724-Oct-202227saepuno1
26410028287-Oct-2022abdsafa14100287-Oct-202228abdsafa1
27410029297-Oct-2022MAZLAAH24100297-Oct-202229MAZLAAH2
284100303017-Oct-2022MAZLAAH241003017-Oct-202230MAZLAAH2
294100313118-Oct-2022MAZLAAH241003118-Oct-202231MAZLAAH2
304100323223-Oct-2022saepuno141003223-Oct-202232saepuno1
314100333331-Oct-2022abdsafa141003331-Oct-202233abdsafa1
32410034348-Oct-2022MAZLAAH24100348-Oct-202234MAZLAAH2
3341003517-Oct-202235MAZLAAH2
Summary2
Click to expand...
Hi @kevin9999,
I tried to simplify the list, you could test it.
Thanks
 
Upvote 0
Thanks you for providing a sample using the XL2BB - much appreciated, it makes life so much easier ;)
I'm not going to say that the code below is the final solution, but I believe it does get closer to what you want. (As before, just watch the sheet name)
When I run this code on your sample data:

VBA Code: 
Option Explicit
Sub greenbubble_2()
    Application.ScreenUpdating = 0
    Application.Calculation = xlManual
    Dim Ws As Worksheet
    Set Ws = Worksheets("Summary2") '<<< Change sheet name to suit
    Dim LRow As Long, i As Long, j As Long
    LRow = Ws.Cells(Rows.Count, 1).End(3).Row
    
    For i = LRow To 1 Step -1
        j = WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1))
            If j > 1 Then
                Ws.Cells(i, 1).Offset(1).Resize(j - 1, 4).Insert xlDown
            End If
    Next i
    
    LRow = Ws.Cells(Rows.Count, 5).End(3).Row
    For i = 1 To LRow
        If Ws.Cells(i, 1) <> "" And Ws.Cells(i, 1) <> Ws.Cells(i, 5) Then
            If WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1)) = 0 Then
                If Ws.Cells(i, 1) > Ws.Cells(i, 5) Then
                    Ws.Cells(i, 1).Resize(, 4).Insert xlDown
                    Else
                    Ws.Cells(i, 5).Resize(, 4).Insert xlDown
                End If
                Else
                    If WorksheetFunction.CountIf(Range("A:A"), Ws.Cells(i, 5)) = 0 Then
                        Ws.Cells(i, 1).Resize(, 4).Insert xlDown
                    End If
            End If
            LRow = LRow + 1
        End If
    Next i
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = 1
End Sub

It changed your sample data to this:
greenbubble.xlsm
ABCDEFGH
141000117/10/2022abdsafa14100017/10/20221abdsafa1
2410002217/10/2022saepuno141000217/10/20222saepuno1
3410003325/10/2022abdsafa141000325/10/20223abdsafa1
4410004418/10/2022MAZLAAH241000418/10/20224MAZLAAH2
5410005529/10/2022MAZLAAH2
641000666/10/2022abdsafa14100066/10/20226abdsafa1
7410007722/10/2022MAZLAAH241000722/10/20227MAZLAAH2
841000828/10/20228MAZLAAH2
941000998/10/2022MAZLAAH24100098/10/20229MAZLAAH2
104100101016/10/2022MAZLAAH241001016/10/202210MAZLAAH2
114100111117/10/2022MAZLAAH241001117/10/202211MAZLAAH2
12410012121/10/2022abdsafa14100121/10/202212abdsafa1
134100131316/10/2022abdsafa141001316/10/202213abdsafa1
144100141421/10/2022MAZLAAH241001421/10/202214MAZLAAH2
154100151522/10/2022MAZLAAH241001522/10/202215MAZLAAH2
164100161611/10/2022MAZLAAH241001611/10/202216MAZLAAH2
174100171720/10/2022saepuno141001720/10/202217saepuno1
18410018189/10/2022abdsafa14100189/10/202218abdsafa1
194100191924/10/2022saepuno141001924/10/202219saepuno1
204100204/10/202220abdsafa1
214100212112/10/2022abdsafa1
224100222217/10/2022saepuno141002217/10/202222saepuno1
234100232321/10/2022MAZLAAH241002321/10/202223MAZLAAH2
244100242427/10/2022MAZLAAH241002427/10/202224MAZLAAH2
25410025253/10/2022abdsafa14100253/10/202225abdsafa1
264100262618/10/2022MAZLAAH241002618/10/202226MAZLAAH2
274100272724/10/2022saepuno141002724/10/202227saepuno1
28410028287/10/2022abdsafa14100287/10/202228abdsafa1
29410029297/10/2022MAZLAAH24100297/10/202229MAZLAAH2
304100303017/10/2022MAZLAAH241003017/10/202230MAZLAAH2
314100313118/10/2022MAZLAAH241003118/10/202231MAZLAAH2
324100323223/10/2022saepuno141003223/10/202232saepuno1
334100333331/10/2022abdsafa141003331/10/202233abdsafa1
34410034348/10/2022MAZLAAH24100348/10/202234MAZLAAH2
3541003517/10/202235MAZLAAH2
Summary2
 
Upvote 0
kevin9999 said:
Thanks you for providing a sample using the XL2BB - much appreciated, it makes life so much easier ;)
I'm not going to say that the code below is the final solution, but I believe it does get closer to what you want. (As before, just watch the sheet name)
When I run this code on your sample data:

VBA Code: 
Option Explicit
Sub greenbubble_2()
    Application.ScreenUpdating = 0
    Application.Calculation = xlManual
    Dim Ws As Worksheet
    Set Ws = Worksheets("Summary2") '<<< Change sheet name to suit
    Dim LRow As Long, i As Long, j As Long
    LRow = Ws.Cells(Rows.Count, 1).End(3).Row
   
    For i = LRow To 1 Step -1
        j = WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1))
            If j > 1 Then
                Ws.Cells(i, 1).Offset(1).Resize(j - 1, 4).Insert xlDown
            End If
    Next i
   
    LRow = Ws.Cells(Rows.Count, 5).End(3).Row
    For i = 1 To LRow
        If Ws.Cells(i, 1) <> "" And Ws.Cells(i, 1) <> Ws.Cells(i, 5) Then
            If WorksheetFunction.CountIf(Range("E:E"), Ws.Cells(i, 1)) = 0 Then
                If Ws.Cells(i, 1) > Ws.Cells(i, 5) Then
                    Ws.Cells(i, 1).Resize(, 4).Insert xlDown
                    Else
                    Ws.Cells(i, 5).Resize(, 4).Insert xlDown
                End If
                Else
                    If WorksheetFunction.CountIf(Range("A:A"), Ws.Cells(i, 5)) = 0 Then
                        Ws.Cells(i, 1).Resize(, 4).Insert xlDown
                    End If
            End If
            LRow = LRow + 1
        End If
    Next i
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = 1
End Sub

It changed your sample data to this:
greenbubble.xlsm
ABCDEFGH
141000117/10/2022abdsafa14100017/10/20221abdsafa1
2410002217/10/2022saepuno141000217/10/20222saepuno1
3410003325/10/2022abdsafa141000325/10/20223abdsafa1
4410004418/10/2022MAZLAAH241000418/10/20224MAZLAAH2
5410005529/10/2022MAZLAAH2
641000666/10/2022abdsafa14100066/10/20226abdsafa1
7410007722/10/2022MAZLAAH241000722/10/20227MAZLAAH2
841000828/10/20228MAZLAAH2
941000998/10/2022MAZLAAH24100098/10/20229MAZLAAH2
104100101016/10/2022MAZLAAH241001016/10/202210MAZLAAH2
114100111117/10/2022MAZLAAH241001117/10/202211MAZLAAH2
12410012121/10/2022abdsafa14100121/10/202212abdsafa1
134100131316/10/2022abdsafa141001316/10/202213abdsafa1
144100141421/10/2022MAZLAAH241001421/10/202214MAZLAAH2
154100151522/10/2022MAZLAAH241001522/10/202215MAZLAAH2
164100161611/10/2022MAZLAAH241001611/10/202216MAZLAAH2
174100171720/10/2022saepuno141001720/10/202217saepuno1
18410018189/10/2022abdsafa14100189/10/202218abdsafa1
194100191924/10/2022saepuno141001924/10/202219saepuno1
204100204/10/202220abdsafa1
214100212112/10/2022abdsafa1
224100222217/10/2022saepuno141002217/10/202222saepuno1
234100232321/10/2022MAZLAAH241002321/10/202223MAZLAAH2
244100242427/10/2022MAZLAAH241002427/10/202224MAZLAAH2
25410025253/10/2022abdsafa14100253/10/202225abdsafa1
264100262618/10/2022MAZLAAH241002618/10/202226MAZLAAH2
274100272724/10/2022saepuno141002724/10/202227saepuno1
28410028287/10/2022abdsafa14100287/10/202228abdsafa1
29410029297/10/2022MAZLAAH24100297/10/202229MAZLAAH2
304100303017/10/2022MAZLAAH241003017/10/202230MAZLAAH2
314100313118/10/2022MAZLAAH241003118/10/202231MAZLAAH2
324100323223/10/2022saepuno141003223/10/202232saepuno1
334100333331/10/2022abdsafa141003331/10/202233abdsafa1
34410034348/10/2022MAZLAAH24100348/10/202234MAZLAAH2
3541003517/10/202235MAZLAAH2
Summary2
Click to expand...
Thanks kevin9999, it's work perfectly.👏👍
FYI, my data will be up to 1500 row and i just tested and it take around 5 minutes to complete. Is there any way to speed up the process?
 
Upvote 0
greenbubble said:
Thanks kevin9999, it's work perfectly.👏👍
FYI, my data will be up to 1500 row and i just tested and it take around 5 minutes to complete. Is there any way to speed up the process?
Click to expand...
Happy to hear it's working for you, not so happy it's taking so long to run. Leave that one with me, I'll see if I can do something about it. 👍
 
Upvote 0
greenbubble said:
FYI, my data will be up to 1500 row and i just tested and it take around 5 minutes to complete.
Click to expand...
I just did a test with 1500 rows of data & it ran in around 6.5 seconds :unsure:
To be able to help, I really need to see the actual file you're using. Are you able to share your actual file via Dropbox, Google Drive or some other file sharing platform?
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
102
irishjsk
I
K
  • Question
Comparing two sheets
Replies
3
Views
861
Killragtshirts
K
P
  • Solved
VBA Match data, find mismatch data and copy data to validation sheet. Not working correctly.
2
Replies
16
Views
774
pawcoyote
P
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
409
AndyEd
A
I
  • Question
VBA: Search for keywords in data strings and perform actions with that data
Replies
3
Views
339
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,110
Messages
6,123,140
Members
449,098
Latest member
Doanvanhieu

Share this page

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
Back
Top