this code is VERY slow, is it the code or perhaps a worksheet issue

[GS]

Just for interest I set up 512 rows of data and reran my code revised
as follows, using the Timer as did Joeu2004.

It took 0.5313 secs in XL2003; 0.4844 secs in XL2007!

Layout is the same as my previous test. ("X" in colA for 256
non-contiguous rows, data in colsB:C for 512 contiguous rows)

Sub CopyLeft_v2()
Dim rng As Range, lRow As Long, dStart As Double

'Range to be checked is from row1 to resize constant above,
'where the active cell is in row1/column1 of the data to shift.
'//**assumes contiguous rows of data**
Set rng = ActiveCell.Resize(ActiveCell.End(xlDown).Row)
dStart = Timer
For lRow = 1 To rng.Rows.Count
With rng
With .Cells(lRow)
If .Offset(0, -1).Value = "X" Then _
.Resize(1, 2).Cut .Offset(0, -1)
End With '.Cells(lRow)
End With 'rng
Next 'lRow
Debug.Print Format(Timer - dStart, "0.0000") & " sec"
End Sub 'CopyLeft()

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Just thought I'd add that subsequent iterations went quicker...

XL2003: 0.5156 secs
XL2007: 0.3594 secs

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[joeu2004]

Just for interest I set up 512 rows of data and reran my code revised as
follows, using the Timer as did Joeu2004.
It took 0.5313 secs in XL2003; 0.4844 secs in XL2007!

As I posted almost 10 hours earlier. But it might have gotten lost in the
"forest"....

-----

From: "joeu2004" <[email protected]>
Newsgroups: microsoft.public.excel.programming
Subject: Re: this code is VERY slow, is it the code or perhaps a worksheet
issue
Date: Sun, 7 Oct 2012 01:48:53 -0700
Message-ID: <[email protected]>
[....]
There seems to be defect in Excel 2010 or its VBA.

When I run the modified code in Excel 2007, it takes consistently less than
0.8 seconds to move 1500 rows to the left.

In Excel 2010, initially it takes about 3.4 seconds. And sometimes it is
consistent, at least for a while.

(Of course, times vary from computer to computer. The important things to
note is the __relative__ times.)

But eventually, I get into a state where the implementation takes
increasingly longer. I don't know why. And I don't know what clears that
state occassionally.

-----

Note that my times are for 1500 data, the maximum according to one of
Howard's postings.

And yes, I had noticed that Excel 2003 seems slightly slower than Excel
2007. But that is based on only one sampling. I did not do an analysis to
determine if the difference is statistically significant.

 

[Don Guillett]

Excel 2010



When I run this code it takes a tiny bit less than one second for each entry with no "X" in the column to the left and at least a full second if it has to cut & paste the resized cells in response to the "X" in the column to the left.



The worksheet also seems to be slower than normal using common sheet procedures like selecting a couple of cells and draging them to another column,same slowness with cut and paste of 150 to 250 entries in a column to another column.



The sheets data is about 50 columns by 300 rows and a "storage column" just over 1000 rows. Doesn't seem like much data after some examples I have heard about in these news groups.



I'm going on poor memory here now, but I seem to recall some reason for slowness may be a HUGE used range on the sheet. Cure was something like selectin all the empty rows beyond what you need and do something with them and then do the same with the columns. Save and restate Excel might be part of the cure also. I have used Ctrl + down arrow several times and gone to the million'th plus row (bottom of the column). Maybe thats it???



Any ideas?



Option Explicit

Sub CopyLeft()

'activecell must start row 1 to row 16 of column



Dim c As Range

Dim j As Integer

ActiveCell.End(xlDown).Select



j = ActiveCell.End(xlDown).Row

ActiveCell.Resize(j - 16, 1).Select



With Selection

For Each c In Selection

If c.Offset(0, -1).Value = "X" Then

c.Resize(1, 2).Cut c.Offset(0, -2)

End If

Next

End With



End Sub



Thanks.

Regards,

Howard

Assuming the CF has been applied and OP selects row17 of the source cell with the shaded cells, this will do as desired.
Option Explicit

Sub SeparateDuplicatesFromNonDuplicates()
Dim mc As Long
Dim lr As Long
'========
mc = ActiveCell.Column


Application.ScreenUpdating = False
If mc = 0 Or ActiveCell.Row <> 17 Then Exit Sub
Cells(17, "ae").Resize(1000, 2).Clear

lr = Cells(Rows.Count, mc).End(xlUp).Row
Range(Cells(17, mc), Cells(lr, mc + 1)).Copy Range("ag17")
With Range("$AG$16:$AH$" & lr)
.AutoFilter Field:=1, Criteria1:=RGB(255 _
, 199, 206), Operator:=xlFilterCellColor
.Offset(1).SpecialCells(xlCellTypeVisible).Copy Range("ae17")
.Offset(1).SpecialCells(xlCellTypeVisible).Clear
.AutoFilter
.SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End With
Application.ScreenUpdating = True
Range("ae17").Select
Range("ag13") = "You selected cell " & Cells(17, mc).Address
End Sub

 

[Howard]

How about a clean way? ;-)



First, if your are using Conditional Formatting only for this purpose, and

if the following suggestions work for you, it is important that you

eliminate the CFs.



In other forums, others have claimed that (some) CFs are "volatile"

formulas. So for each cut-and-paste that you might do, __all__ of the CFs

are re-evaluated. And that might sense given your application.



That could explain why your algorithm takes so much longer for you (18 to30

sec, you said) than for me (3.4 sec, but increasing each time sometimes).



Second, the following macro might do what you require. It assumes that you

format the columns separately. It also assumes that you select at least the

upper-left cell of the 2-column data.



The following macro behaves similar to yours: it simply moves duplicatesto

the left. That leaves gaps in the original data.



On my computer (YMMV), the run time is less than 0.08 seconds for 1500 data

with 1499 duplicates (worst case), compared to 3.4 seconds or more for your

cut-and-paste algorithm.



Caveat: I am guessing at the condition that identifies a duplicate, namely

that the values in __both__ columns are the same; that is:



If orig(j, 1) = orig(i, 1) And orig(j, 2) = orig(i, 2) Then



Remove either ``And orig(j, 2) = orig(i, 2)`` or ``orig(j, 1) = orig(i, 1)

And`` if only one comparison is needed.





' assume upper-left cell of data is selected

' and data are 2 rows or more

Sub moveDupe()

Dim st As Double

Dim origRng As Range

Dim orig As Variant

Dim n As Long, i As Long, j As Long

st = Timer

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

End With

Set origRng = Range(ActiveCell, ActiveCell.End(xlDown)).Resize(, 2)

orig = origRng

n = UBound(orig, 1)

ReDim dupe(1 To n, 1 To 2) As Variant

For i = 1 To n - 1

If orig(i, 1) <> "" And orig(i, 2) <> "" Then

For j = i + 1 To n

If orig(j, 1) = orig(i, 1) And orig(j, 2) = orig(i, 2) Then

dupe(j, 1) = orig(j, 1)

dupe(j, 2) = orig(j, 2)

orig(j, 1) = ""

orig(j, 2) = ""

End If

Next

End If

Next

origRng = orig

origRng.Offset(0, -2) = dupe

With Application

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True

End With

MsgBox Format(Timer - st, "0.000") & " sec"

End Sub





The following macro builds two lists so that are no gaps in either one. The

run time is about the same, under 0.08 seconds on my computer.





' assume upper-left cell of data is selected

' and data are 2 rows or more

Sub moveDupejoeuNG()

Dim st As Double

Dim origRng As Range

Dim orig As Variant

Dim n As Long, i As Long, j As Long

Dim un As Long, dn As Long

st = Timer

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

End With

Set origRng = Range(ActiveCell, ActiveCell.End(xlDown)).Resize(, 2)

orig = origRng

n = UBound(orig, 1)

ReDim uniq(1 To n, 1 To 2) As Variant

ReDim dupe(1 To n, 1 To 2) As Variant

un = 0: dn = 0

For i = 1 To n - 1

If orig(i, 1) <> "" And orig(i, 2) <> "" Then

For j = i + 1 To n

If orig(j, 1) = orig(i, 1) And orig(j, 2) = orig(i, 2) Then

dn = dn + 1

dupe(dn, 1) = orig(j, 1)

dupe(dn, 2) = orig(j, 2)

orig(j, 1) = ""

orig(j, 2) = ""

End If

Next

un = un + 1

uniq(un, 1) = orig(i, 1)

uniq(un, 2) = orig(i, 2)

End If

Next

origRng = uniq

origRng.Offset(0, -2) = dupe

With Application

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True

End With

MsgBox Format(Timer - st, "0.000") & " sec"

End Sub

Hi Joeu,
This is the code you offered that does the "No Gaps" and as far as I can tell in my short experimenting with it is heading in the right direction! The only problem is that the condition that identifies a duplicate in in the XO column only. Is that fixable, to identify the dupes within the XO colomnand move the data with no gaps??? If so then I believe we have a winner.

I renamed it so I can keep track of who authored it and the NG is for No Gaps.

(From your message above)

Caveat: I am guessing at the condition that identifies a duplicate, namely
that the values in __both__ columns are the same; that is:

If orig(j, 1) = orig(i, 1) And orig(j, 2) = orig(i, 2) Then
Remove either ``And orig(j, 2) = orig(i, 2)`` or ``orig(j, 1) = orig(i, 1)

And`` if only one comparison is needed.

Sub moveDupejoeuNGap()

Dim st As Double
Dim origRng As Range
Dim orig As Variant
Dim n As Long, i As Long, j As Long
Dim un As Long, dn As Long

st = Timer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set origRng = Range(ActiveCell, ActiveCell.End(xlDown)).Resize(, 2)
orig = origRng
n = UBound(orig, 1)
ReDim uniq(1 To n, 1 To 2) As Variant
ReDim dupe(1 To n, 1 To 2) As Variant
un = 0: dn = 0
For i = 1 To n - 1
If orig(i, 1) <> "" And orig(i, 2) <> "" Then
For j = i + 1 To n
If orig(j, 1) = orig(i, 1) And orig(j, 2) = orig(i, 2) Then
dn = dn + 1
dupe(dn, 1) = orig(j, 1)
dupe(dn, 2) = orig(j, 2)
orig(j, 1) = ""
orig(j, 2) = ""
End If
Next
un = un + 1
uniq(un, 1) = orig(i, 1)
uniq(un, 2) = orig(i, 2)
End If
Next
origRng = uniq
origRng.Offset(0, -2) = dupe
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[joeu2004]

This is the code you offered that does the "No Gaps"
and as far as I can tell in my short experimenting
with it is heading in the right direction! The only
problem is that the condition that identifies a duplicate
in in the XO column only. Is that fixable, to identify
the dupes within the XO colomn and move the data with no gaps???

Anything is possible. But I'm not sure I understand what you want to do v.
what you had said you were trying to do before.

In particular, I'm not sure what you mean by "XO column".

I think you are asking to use the same column of X's that you had done
before -- namely, the column to the left of the 2-column data.

But you had explained that you create the column of X's manually by looking
at the color of the data, which was set by a condition format to identify
duplicates.

(Did I understand that correctly?)

I was suggesting that you eschew both the conditional formatting (which can
impact performance adversely) and the column of X's.

Instead, I was suggesting that you put the logic of identifying duplicates
into the macro itself.

If you are now amenable to that, the only issue that remains is: how do you
identify duplicates?

I assume that it two lines of data are duplicates if __both__ columns of
data are the same.

Is that correct?

Or are two lines of data considered duplicates if only __one__ column of
data is the same?

If the latter, which column?

-----

Aha! I missed one of your postings. You wrote:

My Excel 2010 Conditional formatting for this sheet is:
Home > Conditional formatting > High light CF Rules >
Duplicate Values > Duplicate Box > Format cells that contain:
"Duplicate" values with "Light Red Fill" > OK.

To be honest, I am not familiar with the semantics of the Excel 2010
new-style CFs. I always enter explicit formulas, like the old way. ("You
cannot teach old dogs new tricks".)

I think this rule is straight-forward. I will need to experiment to be sure
that works the way I expect.

But the key question is: what column or columns (plural) does this CF apply
to?

You have two columns of data from which you want to separate duplicates.
Call the columns E and F, for example.

Does the CF apply to column E or column F or both(!)?

 

[Don Guillett]

Excel 2010



When I run this code it takes a tiny bit less than one second for each entry with no "X" in the column to the left and at least a full second if it has to cut & paste the resized cells in response to the "X" in the column to the left.



The worksheet also seems to be slower than normal using common sheet procedures like selecting a couple of cells and draging them to another column,same slowness with cut and paste of 150 to 250 entries in a column to another column.



The sheets data is about 50 columns by 300 rows and a "storage column" just over 1000 rows. Doesn't seem like much data after some examples I have heard about in these news groups.



I'm going on poor memory here now, but I seem to recall some reason for slowness may be a HUGE used range on the sheet. Cure was something like selectin all the empty rows beyond what you need and do something with them and then do the same with the columns. Save and restate Excel might be part of the cure also. I have used Ctrl + down arrow several times and gone to the million'th plus row (bottom of the column). Maybe thats it???



Any ideas?



Option Explicit

Sub CopyLeft()

'activecell must start row 1 to row 16 of column



Dim c As Range

Dim j As Integer

ActiveCell.End(xlDown).Select



j = ActiveCell.End(xlDown).Row

ActiveCell.Resize(j - 16, 1).Select



With Selection

For Each c In Selection

If c.Offset(0, -1).Value = "X" Then

c.Resize(1, 2).Cut c.Offset(0, -2)

End If

Next

End With



End Sub



Thanks.

Regards,

Howard

Actually, using xl2007 or xl2010 this may be very simple. Simply put this code in the sheet module and then doubleclick on row 17 or the column with the x's & o's such as x0000xxx

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

 

[GS]

Joe,
I agree with your findings. My times are using the same machine running
duo 1.63Ghz processors<FWIW>. Since I rarely turn this machine off, I
never know what resources are available at any given time without
checking.

My point for posting the processing time is to demonstrate the time
Howard's process is taking to complete lies elsewhere (as already
suspected by some), NOT in the task of shifting the data.

I tried doing 1500 rows of data and got the following results...

XL2003: 1.3438 secs
XL2007: 0.7969 secs

Note that these times are not the initial run, but are consistent as
subsequent runs. I also have no idea why XL2003 is considertably slower
than XL2007. I can't speak to XL2010 because I haven't yet installed it
due to the numerous reports I've read about it's 'buggy-ness'. (I might
break down and install it on my new[er] Win7 Pro machine purely for
interest since none of my clients actually use it yet.<g>)

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[joeu2004]

PS.... I wrote:

Is that fixable, to identify the dupes within the
XO colomn and move the data with no gaps???

[....]
I think you are asking to use the same column of X's
that you had done before -- namely, the column to the
left of the 2-column data.

I believe the following macro does that. I do __not__ recommend it.

Also, there is something for you to review.

Previously, you stated that you identify duplicates by using an Excel 2010
Duplicate conditional format, then manually marking "X" next to columns that
are colored (duplicates).

In my experiments, I found that the CF colors all duplicates, not just the
ones after the first appearance. So if we have a column of alternating 1s
and 2s, __all__ cells are colored.

But your original implementation would work (as I expect it, at least) only
if the first appearance of a duplicate is not marked with "X".

I assume you ensure that requirement is met manually. Gee, it must be
difficult when you have 1500 rows of who-knows-how-many distinct values.

(Again, I prefer to obviate the need for all that manual processing and
conditional formatting.)

The macro below makes the same assumption about your manual marking
procedure.

-----

' assume upper-left cell of data is selected
' and data are 2 rows or more.
' assume column of X's to the left identifies
' rows to be moved to dupe column.
' no gaps in resulting dupe and orig columns
Sub moveDupe()
Dim st As Double
Dim origRng As Range
Dim orig As Variant
Dim n As Long, i As Long
Dim un As Long, dn As Long
st = Timer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' original data is 2 columns
Set origRng = Range(ActiveCell, ActiveCell.End(xlDown)).Resize(, 2)
' copy in original data plus "X" column to the left
orig = origRng.Offset(0, -1).Resize(, 3)
n = UBound(orig, 1)
ReDim uniq(1 To n, 1 To 2) As Variant
ReDim dupe(1 To n, 1 To 2) As Variant
un = 0: dn = 0
For i = 1 To n
' assume no "X" in first appearance of duplicate data
If orig(i, 1) = "X" Then
dn = dn + 1
dupe(dn, 1) = orig(i, 2)
dupe(dn, 2) = orig(i, 3)
Else
un = un + 1
uniq(un, 1) = orig(i, 2)
uniq(un, 2) = orig(i, 3)
End If
Next
origRng = uniq
origRng.Offset(0, -2) = dupe
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub

 

[Don Guillett]

Excel 2010



When I run this code it takes a tiny bit less than one second for each entry with no "X" in the column to the left and at least a full second if it has to cut & paste the resized cells in response to the "X" in the column to the left.



The worksheet also seems to be slower than normal using common sheet procedures like selecting a couple of cells and draging them to another column,same slowness with cut and paste of 150 to 250 entries in a column to another column.



The sheets data is about 50 columns by 300 rows and a "storage column" just over 1000 rows. Doesn't seem like much data after some examples I have heard about in these news groups.



I'm going on poor memory here now, but I seem to recall some reason for slowness may be a HUGE used range on the sheet. Cure was something like selectin all the empty rows beyond what you need and do something with them and then do the same with the columns. Save and restate Excel might be part of the cure also. I have used Ctrl + down arrow several times and gone to the million'th plus row (bottom of the column). Maybe thats it???



Any ideas?



Option Explicit

Sub CopyLeft()

'activecell must start row 1 to row 16 of column



Dim c As Range

Dim j As Integer

ActiveCell.End(xlDown).Select



j = ActiveCell.End(xlDown).Row

ActiveCell.Resize(j - 16, 1).Select



With Selection

For Each c In Selection

If c.Offset(0, -1).Value = "X" Then

c.Resize(1, 2).Cut c.Offset(0, -2)

End If

Next

End With



End Sub



Thanks.

Regards,

Howard

Correction to do BOTH columns based on the first, Leaves the FIRST dup.
correct for line warp

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Range(Selection, Selection.End(xlDown)).resize(,2).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

 

[joeu2004]

Previously, you stated that you identify duplicates by
using an Excel 2010 Duplicate conditional format, then
manually marking "X" next to columns that are colored
(duplicates).

Pay close attention to the details of any proposed solution, especially
mine.

I just realized there are other interpretations of "move duplicates" that
would have very different results.

I could easily tweak my solutions to accommodate these other
interpretations. I just need to know precisely what your requirements are.

Let's do this by example. If the following examples are insufficient,
please embellish them with examples of your own.

(Sigh, I should have asked for this at the outset instead of making
assumptions.)

-----

Suppose your data are as follows:

E17: 3 F17: a
E18: 2 F18: b
E19: 1 F19: c
E20: 3 F20: a
E21: 1 F21: c

Which result do you want (if neither, what do you want)?


(1a) what my solutions create:

C17: 3 D17: a E17: 3 F17: a
C18: 1 D18: c E18: 2 F18: b
---- - ---- - E19: 1 F19: c

All duplicates __except__ the first appearance are moved to the left.


(1b) alternatively:

C17: 3 D17: a E17: 2 F17: b
C18: 3 D18: a
C19: 1 D19: c
C20: 1 D20: c

__All__ duplicates are moved to the left.


-----

And while we're at it, what defines a "duplicate"?

Suppose your data are as follows:

E17: 3 F17: a
E18: 2 F18: a
E19: 1 F19: b
E20: 3 F20: c
E21: 1 F21: b


(2a) what my solutions create:

C17: 1 D17: b E17: 3 F17: a
---- - ---- - E18: 2 F18: a
---- - ---- - E19: 1 E19: b
---- - ---- - E20: 3 F20: c

Duplicates based on __both__ columns E and F.


(2b) alternative:

C17: 3 D17: c E17: 3 F17: a
C18: 1 D18: b E18: 2 F18: a
---- - ---- - E19: 1 F19: b

Duplicates are based on column E only.


(2c) alternative:

C17: 2 D17: a E17: 3 F17: a
C18: 1 D18: b E18: 1 F18: b
---- - ---- - E19: 3 F19: c

Duplicates are based on column F only.


(2d) alternative:

C17: 2 D17: a E17: 3 F17: a
C18: 1 D18: b E18: 1 F18: b
C19: 3 D19: c

Duplicates are based on column E __or__ column F.

 

[joeu2004]

Previously, you stated that you identify duplicates by
using an Excel 2010 Duplicate conditional format, then
manually marking "X" next to columns that are colored
(duplicates).

Pay close attention to the details of any proposed solution [....]
And while we're at it, what defines a "duplicate"?

And if the compared data (whatever defines a duplicate) are text, do you
want a case-sensitive or case-insensitive comparison?

The Duplicate Conditional Format feature is case-insensitive. But by
default, VBA comparison is case-sensitive.

 

[Howard]

Pay close attention to the details of any proposed solution, especially

mine.



I just realized there are other interpretations of "move duplicates" that

would have very different results.



I could easily tweak my solutions to accommodate these other

interpretations. I just need to know precisely what your requirements are.



Let's do this by example. If the following examples are insufficient,

please embellish them with examples of your own.



(Sigh, I should have asked for this at the outset instead of making

assumptions.)



-----



Suppose your data are as follows:



E17: 3 F17: a

E18: 2 F18: b

E19: 1 F19: c

E20: 3 F20: a

E21: 1 F21: c



Which result do you want (if neither, what do you want)?





(1a) what my solutions create:



C17: 3 D17: a E17: 3 F17: a

C18: 1 D18: c E18: 2 F18: b

---- - ---- - E19: 1 F19: c



All duplicates __except__ the first appearance are moved to the left.





(1b) alternatively:



C17: 3 D17: a E17: 2 F17: b

C18: 3 D18: a

C19: 1 D19: c

C20: 1 D20: c



__All__ duplicates are moved to the left.





-----



And while we're at it, what defines a "duplicate"?



Suppose your data are as follows:



E17: 3 F17: a

E18: 2 F18: a

E19: 1 F19: b

E20: 3 F20: c

E21: 1 F21: b





(2a) what my solutions create:



C17: 1 D17: b E17: 3 F17: a

---- - ---- - E18: 2 F18: a

---- - ---- - E19: 1 E19: b

---- - ---- - E20: 3 F20: c



Duplicates based on __both__ columns E and F.





(2b) alternative:



C17: 3 D17: c E17: 3 F17: a

C18: 1 D18: b E18: 2 F18: a

---- - ---- - E19: 1 F19: b



Duplicates are based on column E only.





(2c) alternative:



C17: 2 D17: a E17: 3 F17: a

C18: 1 D18: b E18: 1 F18: b

---- - ---- - E19: 3 F19: c



Duplicates are based on column F only.





(2d) alternative:



C17: 2 D17: a E17: 3 F17: a

C18: 1 D18: b E18: 1 F18: b

C19: 3 D19: c



Duplicates are based on column E __or__ column F.

Hi joeu

Defining a duplicate. For my purpose the three XXOO in E17,18,19 are duplicates as are the two XOOX in E20, 21. Column F does not come into play determining a duplicate. (The XOOX in E22 & SEEK in F22 would be an outright typo mistake made during data entry. I believe we can disregard that entry, I show it only to eliminate it as being considered as a dupe in the solution process.)

Regarding vba case-sensitive, all data is upper case.

My "make-a-wish" ultimate solution would be this:
* E22 & F22 Not considered.

E F
17 XXOO YELL
18 XXOO TELL
19 XXOO LESS
20 XOOX KEEP
21 XOOX SEEK
22 XOOX SEEK*


A B C D E F
XXOO TELL XXOO LESS XXOO YELL
XOOX SEEK XOOX KEEP

Non-dupes remain in cols E & F.

Regards,
Howard