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

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - this code is VERY slow, is it the code or perhaps a worksheet issue (https://www.excelbanter.com/excel-programming/447305-code-very-slow-code-perhaps-worksheet-issue.html)

Howard

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

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

joeu2004[_2_]

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

"Howard" wrote:
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.

From your description, the problem is not where the size of the "used range"
in the worksheet. Instead, I suspect it is due to a large number of
"volatile" formulas (or dependencies on them) and/or the use of full-column
ranges like A:A.

Those issues should be addressed. But there are a number of things that you
can do to improve the run-time of the macro, despite those issues.

At a minimum, you should disable ScreenUpdating and set Manual calculation
mode. If you have any event macros, you might want to disable events as
well.

Try this (note also the change in Dim j):

Option Explicit
Sub CopyLeft()
'activecell must start row 1 to row 16 of column
Dim c As Range
Dim j As Long ' *** unrelated improvement ***
Dim st as Double ' *** debug ***
st = Timer ' *** debug ***
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
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
' *** execute these statements in Immed Window ***
' *** if macro should abort for any reason ***
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
' *** Timer-st is not valid across midnight ***
MsgBox Format(Timer - st, "0.000") & " sec" ' *** debug ***
End Sub

Howard

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

Don Guillett[_2_]

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

GS[_2_]

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

<IMO
I'm pretty sure the fastest way to handle this is to 'dump' the entire
usedRange into an array, work the array as desired, then 'dump' the
results back into the worksheet.

I base this on the fact that your code reads/writes the worksheet for
each iteration. Also, you spend tonnes of time selecting things that
don't need to be selected, but could be worked on directly if you need
to read/write the worksheet.

--
Garry

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

Howard

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

GS[_2_]

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

Try this...

Assumes ColA contains "X" in some rows; Cols B/C contain data that will
be shifted to Cols A/B if colA contains "X". (Modify to suit your
layout)

Sub CopyLeft()
Dim rng As Range, lRow As Long
Const NumRows As Long = 16 '//edit size as required

'Range to be checked is from row1 to resize constant above,
'where the active cell is in row1/column1 of the data to shift.
Set rng = ActiveCell.Resize(NumRows)

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

Howard

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

Howard

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

Howard

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

On Saturday, October 6, 2012 1:12:22 AM UTC-7, Howard wrote:
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

On Saturday, October 6, 2012 1:12:22 AM UTC-7, Howard wrote:
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

Garry,

I tried your code and it works fine. I timed it using a house clock with a sweep hand and it took about 35 seconds to do 283 rows. I installed a coded timer I got from one other contributor into your code and it read out 29..9 seconds for the same 283 rows. Seems a bit slow but I will live with it..

Currently I am manually putting the X's in the adjacent column where I want data moved. That is to say I put the X in column A whenever column be is shaded light red. The red shade is from conditional formatting and indicates a duplicate. Is there a way run some code on column B and if the cell is shaded light red, it puts an X in column A? Seems to me conditional formatting colors elusive to code like that. But it would be a huge time saver if that could be done with code.

Thanks for you time and suggestions.
Regards,
Howard

Claus Busch

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

Hi Howard,

Am Sun, 7 Oct 2012 00:59:00 -0700 (PDT) schrieb Howard:

Currently I am manually putting the X's in the adjacent column where I want data moved. That is to say I put the X in column A whenever column be is shaded light red. The red shade is from conditional formatting and indicates a duplicate. Is there a way run some code on column B and if the cell is shaded light red, it puts an X in column A? Seems to me conditional formatting colors elusive to code like that. But it would be a huge time saver if that could be done with code.

please post your formula for condition format.

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

joeu2004[_2_]

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

"Howard" wrote:
Garry,
I tried your code and it works fine.

I'm surprised to see you say that. It does not have the functionality that
your implementation does.

In particular, your original implementation seems to assume that an empty
cell above the data is selected. Your code was:

'activecell must start row 1 to row 16 of column
[....]
ActiveCell.End(xlDown).Select
j = ActiveCell.End(xlDown).Row
ActiveCell.Resize(j - 16, 1).Select

But that implementation is flawed unless that data starts in row 17. If
not, Resize(j-16,1) specifies more than the number of rows in the table.
How much more depends on where the data ends.

I believe the following does what you intended:

Dim c As Range, dataRng As Range
Set dataRng = ActiveCell.End(xlDown)
Set dataRng = Range(dataRng, dataRng.End(xlDown))
For Each c In dataRng

The first ``set dataRng`` finds the beginning of the data, assuming an empty
cell is selected and the data begins in the first non-empty cell below it.

The second ``set dataRng`` finds the end of the data, and it sets dataRng to
the entire data range.

In its entirety, the copyLeft macro becomes:

Sub CopyLeft()
'activecell must start row 1 to row 16 of column
Dim c As Range, dataRng As Range
Dim st As Double
st = Timer
Set dataRng = ActiveCell.End(xlDown)
Set dataRng = Range(dataRng, dataRng.End(xlDown))
For Each c In dataRng
If c.Offset(0, -1).Value = "X" Then
c.Resize(1, 2).Cut c.Offset(0, -2)
End If
Next
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub

"Howard" wrote:
I installed a coded timer I got from one other contributor
into your code and it read out 29.9 seconds for the same
283 rows.

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.

In any case, I wonder if that explains why your version and Garry's takes so
long.

"Howard" wrote:
Seems a bit slow but I will live with it.

You might not need to.

The use of range.Cut is the primary cause of the slow performance. Do you
really need to use range.Cut?

You might indeed need range.Cut if you want to move all of the cell's
formats as well as its value.

But in another posting, you indicated that the data are constants, not
formulas.

If you only need to move the values, not the formats, the following
implementation takes consistently about 0.031 seconds -- 100 times faster.

Sub CopyLeft()
Dim dataRng As Range
Dim v As Variant
Dim st As Double
Dim i As Long, n As Long
st = Timer
' copy 2 columns to the left as well as the 2 columns of data
Set dataRng = ActiveCell.End(xlDown)
Set dataRng = Range(dataRng, dataRng.End(xlDown)).Offset(0, -2).Resize(, 4)
v = dataRng
n = UBound(v, 1)
For i = 1 To n
If v(i, 2) = "X" Then
v(i, 1) = v(i, 3): v(i, 3) = ""
v(i, 2) = v(i, 4): v(i, 4) = ""
End If
Next
dataRng = v
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub

Alternatively, if you need to also move the numeric format (but not all
formats like borders, alignment, condition format, etc), the following
implementation takes consistently about 0.5 seconds -- 6 times faster.

Sub CopyLeft()
Dim dataRng As Range
Dim v As Variant
Dim st As Double
Dim i As Long, n As Long
st = Timer
' copy 2 columns to the left as well as the 2 columns of data
Set dataRng = ActiveCell.End(xlDown)
Set dataRng = Range(dataRng, dataRng.End(xlDown)).Offset(0, -2).Resize(, 4)
v = dataRng
n = UBound(v, 1)
For i = 1 To n
If v(i, 2) = "X" Then
v(i, 1) = v(i, 3): v(i, 3) = ""
v(i, 2) = v(i, 4): v(i, 4) = ""
dataRng(i, 1).NumberFormat = dataRng(i, 3).NumberFormat
dataRng(i, 2).NumberFormat = dataRng(i, 4).NumberFormat
End If
Next
dataRng = v
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub

Howard

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

Claus Busch

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

Hi Howard,

Am Sun, 7 Oct 2012 01:53:15 -0700 (PDT) schrieb Howard:

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.

try in A1:
=IF(COUNTIF($B$1:B1,B1)1,"X","")
and copy down

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Howard

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

Howard

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

On Sunday, October 7, 2012 1:48:58 AM UTC-7, joeu2004 wrote:
"Howard" wrote:

Garry,

I tried your code and it works fine.

I'm surprised to see you say that. It does not have the functionality that

your implementation does.

In particular, your original implementation seems to assume that an empty

cell above the data is selected. Your code was:

'activecell must start row 1 to row 16 of column

[....]

ActiveCell.End(xlDown).Select

j = ActiveCell.End(xlDown).Row

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

But that implementation is flawed unless that data starts in row 17. If

not, Resize(j-16,1) specifies more than the number of rows in the table.

How much more depends on where the data ends.

I believe the following does what you intended:

Dim c As Range, dataRng As Range

Set dataRng = ActiveCell.End(xlDown)

Set dataRng = Range(dataRng, dataRng.End(xlDown))

For Each c In dataRng

The first ``set dataRng`` finds the beginning of the data, assuming an empty

cell is selected and the data begins in the first non-empty cell below it..

The second ``set dataRng`` finds the end of the data, and it sets dataRng to

the entire data range.

In its entirety, the copyLeft macro becomes:

Sub CopyLeft()

'activecell must start row 1 to row 16 of column

Dim c As Range, dataRng As Range

Dim st As Double

st = Timer

Set dataRng = ActiveCell.End(xlDown)

Set dataRng = Range(dataRng, dataRng.End(xlDown))

For Each c In dataRng

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

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

End If

Next

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

End Sub

"Howard" wrote:

I installed a coded timer I got from one other contributor

into your code and it read out 29.9 seconds for the same

283 rows.

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.

In any case, I wonder if that explains why your version and Garry's takes so

long.

"Howard" wrote:

Seems a bit slow but I will live with it.

You might not need to.

The use of range.Cut is the primary cause of the slow performance. Do you

really need to use range.Cut?

You might indeed need range.Cut if you want to move all of the cell's

formats as well as its value.

But in another posting, you indicated that the data are constants, not

formulas.

If you only need to move the values, not the formats, the following

implementation takes consistently about 0.031 seconds -- 100 times faster..

Sub CopyLeft()

Dim dataRng As Range

Dim v As Variant

Dim st As Double

Dim i As Long, n As Long

st = Timer

' copy 2 columns to the left as well as the 2 columns of data

Set dataRng = ActiveCell.End(xlDown)

Set dataRng = Range(dataRng, dataRng.End(xlDown)).Offset(0, -2).Resize(, 4)

v = dataRng

n = UBound(v, 1)

For i = 1 To n

If v(i, 2) = "X" Then

v(i, 1) = v(i, 3): v(i, 3) = ""

v(i, 2) = v(i, 4): v(i, 4) = ""

End If

Next

dataRng = v

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

End Sub

Alternatively, if you need to also move the numeric format (but not all

formats like borders, alignment, condition format, etc), the following

implementation takes consistently about 0.5 seconds -- 6 times faster.

Sub CopyLeft()

Dim dataRng As Range

Dim v As Variant

Dim st As Double

Dim i As Long, n As Long

st = Timer

' copy 2 columns to the left as well as the 2 columns of data

Set dataRng = ActiveCell.End(xlDown)

Set dataRng = Range(dataRng, dataRng.End(xlDown)).Offset(0, -2).Resize(, 4)

v = dataRng

n = UBound(v, 1)

For i = 1 To n

If v(i, 2) = "X" Then

v(i, 1) = v(i, 3): v(i, 3) = ""

v(i, 2) = v(i, 4): v(i, 4) = ""

dataRng(i, 1).NumberFormat = dataRng(i, 3).NumberFormat

dataRng(i, 2).NumberFormat = dataRng(i, 4).NumberFormat

End If

Next

dataRng = v

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

End Sub

Wow, you've given me plenty to chew on. I will tinker with all your suggestions. I'm getting the feeling I am in over my head...

My data does indeed start in row 17 and I just needed a down and dirty way to separate the dupes into a seperate column and then I can minupliate the two columns data as I want. If I use copy it would leave the data in the first column and put a copy of that data in the columns to the left. So I switched to Cut so it would vacate the first column.

If I can get a way to auto install the X's in the left most column where the dupes occur I will be more than happy. Claus has a suggestion and I am off to give it a try along with all the nuggets you have suggested.

I sure do appreciat all the suggestions and dialog from everyone. Sorta like taking an advanced Excel class.

Thanks again to everyone for a ton of help.

Regards,
Howard

Claus Busch

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

Hi Howard,

Am Sun, 7 Oct 2012 03:08:57 -0700 (PDT) schrieb Howard:

My data does indeed start in row 17 and I just needed a down and dirty way to separate the dupes into a seperate column and then I can minupliate the two columns data as I want. If I use copy it would leave the data in the first column and put a copy of that data in the columns to the left. So I switched to Cut so it would vacate the first column.

If I can get a way to auto install the X's in the left most column where the dupes occur I will be more than happy. Claus has a suggestion and I am off to give it a try along with all the nuggets you have suggested.

I sure do appreciat all the suggestions and dialog from everyone. Sorta like taking an advanced Excel class.

enter the "X" with the formual. That's the quickest way to do it.
You are looking for the "X" in column A and then cut B and C in the same
row and paste it to A? Then give following code a try:

Sub CopyLeft()
Dim myRng As Range
Dim FRow As Long
Dim LRow As Long
Dim rngC As Range
Dim st As Double

st = Timer

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

LRow = Cells(Rows.Count, 2).End(xlUp).Row
FRow = WorksheetFunction.Match("X", Range("A1:A" & LRow), 0)
Set myRng = Range(Cells(FRow, 2), Cells(LRow, 2))

For Each rngC In myRng
With rngC
If .Offset(0, -1) = "X" Then
.Resize(1, 2).Cut Destination:=.Offset(0, -1)
End If
End With
Next
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
End With
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub

In 2500 rows with 300 duplicates it took 2,175 sec.

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

joeu2004[_2_]

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

"Howard" wrote:
My data does indeed start in row 17 and I just needed a
down and dirty way to separate the dupes into a seperate
column and then I can minupliate the two columns data as
I want.

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 to 30
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 duplicates to
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 moveDupe()
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

GS[_2_]

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

I only tested 16 rows of data because that't what I understood the row
count to be from your original post. In my test the result was
instantaneous.

As I originally suggested, dumping the data into an array and working
with it there before dumping the array back into the sheet is the
fastest (IMO) way to do this sort of thing. Joeu2004 invested an
impressive amount of time to demonstrate how to do this with a very
good example that also times the process. While his sample code may
seem rather complex to you initially, it's a good demo for this
approach and so I'd recommend you invest the time required to 'get it'
and put it under your belt for future use!

--
Garry

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

Ben McClave

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

Howard,

It seems to me like your original hunch might be right as far as the UsedRange being larger than expected. Excel will run very slowly if an entire column or row of data is being "used".

The quickest way to check this is to press CTRL+End to go to the last used cell on your sheet. If it is way outside of the data range you expect, then delete all unused columns and rows (select an entire column, then press CTRL+Shift+Right Arrow to select all columns, then delete; use a similar approach to delete rows).

After all unused rows and columns are gone, save and close the workbook and reopen it. Press CTRL+End again to see where the data range ends. Run your macros again and click CTRL+End a final time to see if your macros may be inadvertently increasing the size of your UsedRange (for example, by applying formatting to an entire row or column).

Hope this helps,

Ben

GS[_2_]

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

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[_2_]

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

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[_2_]

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

"GS" wrote on Sun, 07 Oct 2012 15:08:42 -0400:
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"
Newsgroups: microsoft.public.excel.programming
Subject: 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:
[....]
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[_2_]

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

On Saturday, October 6, 2012 3:12:22 AM UTC-5, Howard wrote:
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

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

On Sunday, October 7, 2012 9:57:28 AM UTC-7, joeu2004 wrote:
"Howard" wrote:

My data does indeed start in row 17 and I just needed a

down and dirty way to separate the dupes into a seperate

column and then I can minupliate the two columns data as

I want.

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 to 30

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 duplicates to

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 colomn and 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[_2_]

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

"Howard" wrote:
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[_2_]

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

On Saturday, October 6, 2012 3:12:22 AM UTC-5, Howard wrote:
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[_2_]

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

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[s] 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[_2_]

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

PS.... I wrote:
"joeu2004" wrote:
"Howard" 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[_2_]

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

On Saturday, October 6, 2012 3:12:22 AM UTC-5, Howard wrote:
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[_2_]

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

Caveat.... I wrote:
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[_2_]

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

PS.... I wrote:
Caveat.... I wrote:
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

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

On Monday, October 8, 2012 8:06:42 AM UTC-7, joeu2004 wrote:
Caveat.... I wrote:

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.

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

All times are GMT +1. The time now is 05:29 PM.