0

I'm trying to modify VBA code comparing two columns.

I found it at exceltip.com:

Sub PullUniques() Dim rngCell As Range For Each rngCell In Range("A2:A40") If WorksheetFunction.CountIf(Range("B2:B40"), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In Range("B2:B40") If WorksheetFunction.CountIf(Range("A2:A40"), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next End Sub

Since it handles 40 rows I've tried to edit to something like this:

Sub PullUniques() Dim rngCell As Range For Each rngCell In Range("A2").End(xlDown) If WorksheetFunction.CountIf(Range("B2").End(xlDown), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In Range("B2").End(xlDown) If WorksheetFunction.CountIf(Range("A2").End(xlDown), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next End Sub

It gave me only one row that isn't matching for column. Probably I used "End(xlDown)" in a wrong way.

I created something like this, but it is slow (the file I will compare won't exceed 100k rows anyway):

Sub PullUniques() Dim rngCell As Range For Each rngCell In Range("A2:A99999") If WorksheetFunction.CountIf(Range("B2:B99999"), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In Range("B2:B99999") If WorksheetFunction.CountIf(Range("A2:A99999"), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next End Sub

Is there a way to optimize it? Why does End(xlDown) fail?

Improve this question

2 Answers 2

Reset to default
1

Adjust your code as follows:

Sub PullUniques() Dim rngCell As Range For Each rngCell In Range(Range("A2"),Range("A2").End(xlDown)) If WorksheetFunction.CountIf(Range(Range("B2"),Range("B2").End(xlDown)), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In Range(Range("B2"),Range("B2").End(xlDown)) If WorksheetFunction.CountIf(Range(Range("A2"),Range("A2").End(xlDown)), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next End Sub

.End(xlDown) only refers to one cell.

Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

0

This was more of an exercise to see if I can come up with an implementation a bit more efficient

Here are the test results

Compare2Cols() - Rows: 10,001; Time: 0.047 sec; PullUniquesFixed() - 4.277 sec Compare2Cols() - Rows: 20,001; Time: 0.109 sec; PullUniquesFixed() - 15.975 sec Compare2Cols() - Rows: 30,001; Time: 0.156 sec; PullUniquesFixed() - 31.982 sec Compare2Cols() - Rows: 40,001; Time: 0.234 sec; PullUniquesFixed() - 64.472 sec Compare2Cols() - Rows: 50,001; Time: 0.296 sec; PullUniquesFixed() - 104.645 sec Compare2Cols() - Rows: 100,001; Time: 1.232 sec; PullUniquesFixed() - N/A Compare2Cols() - Rows: 500,001; Time: 31.934 sec; PullUniquesFixed() - N/A Compare2Cols() - Rows: 1,048,576; Time: 126.797 sec; PullUniquesFixed() - N/A

.

PullUniquesFixed()

Option Explicit Public Sub PullUniquesFixed() Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet Dim rngCell As Range, t As Double, tr As String t = Timer Application.ScreenUpdating = False With ws.UsedRange For Each rngCell In .Columns(1).Offset(1).Cells If WorksheetFunction.CountIf(.Columns(2), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In .Columns(2).Offset(1).Cells If WorksheetFunction.CountIf(.Columns(1), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next End With Application.ScreenUpdating = True tr = "PullUniques() - Rows: " & Format(ws.UsedRange.Rows.Count, "#,###") & "; " Debug.Print tr & "Time: " & Format(Timer - t, "0.000") & " sec" End Sub

A note related to End(xlDown) - it may not work as you want if you have empty cells in your column. For example, in my test image in column B, Range("B2").End(xlDown) will return row 4 (the same as if you click B2 and press Down Arrow) so it will ignore all cells bellow, so sometimes it might work better if you use Range("B" & Rows.Count).End(xlUp) - same as selecting the last cell in the column (1M rows +) and pressing Up arrow

.

Compare2Cols() - It uses 2 dictionaries and 4 arrays for better performance

Option Explicit Public Sub Compare2Cols() Dim dColA As Object: Set dColA = CreateObject("Scripting.Dictionary") Dim dColB As Object: Set dColB = CreateObject("Scripting.Dictionary") Dim ur As Range: Set ur = ActiveSheet.UsedRange ur.Columns("C:D").Delete Dim arrA As Variant: arrA = ur.Columns("A") Dim arrB As Variant: arrB = ur.Columns("B") Dim arrC As Variant: arrC = ur.Columns("C") Dim arrD As Variant: arrD = ur.Columns("D") Dim itm As Variant, r As Long For Each itm In arrA dColA(itm) = 0 Next For Each itm In arrB dColB(itm) = 0 Next For Each itm In dColA r = r + 1 If Not dColB.Exists(itm) Then arrC(r, 1) = itm 'Find Col 1 in 2 Next r = 0 For Each itm In dColB r = r + 1 If Not dColA.Exists(itm) Then arrD(r, 1) = itm 'Find Col 2 in 1 Next ur.Columns("C") = arrC ur.Columns("D") = arrD End Sub

Test data

TestData

Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.