# Jay Petrulis (reporting back)

#### SteveC

##### Board Regular
Thank you for help on *any* part of this. I cannot figure out the VBA to do this. I'm using Excel 2002. Here's what I'm trying to do:

If there is data (a number) in a cell in either M13 thru M130 or in N13 thru N130
Then copy the cells in columns A, M & N on that same row
And paste into columns DM, DN & DO, respectively
(on any row from 194 thru 358, where the cells in columns DM, DN & DO are empty).
Then, in rows 194 thru 358, sort DM, DN & DO by DM (a date - mmddyy), with the earliest date at the top.

If all three cells to be copied will be an exact match of existing cells on a line in DM, DN & DO (194 thru 358), a duplicate must not be written. (This condition will happen often.)

Any ideas on *any part* of this?
Thanks
SteveC
This message was edited by SteveC on 2002-09-23 20:50
This message was edited by SteveC on 2002-09-26 23:19

### Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Hi,

This does not delete any duplicates, but give this a try and report your results.

<pre>Sub test()
Dim x As Integer, y As Integer, z As Integer
Dim ws As Worksheet
Dim MyArr1
Dim MyArr2
Dim Rng As Range
Dim fn As WorksheetFunction

Set fn = Application.WorksheetFunction
Set ws = ThisWorkbook.Sheets("Sheet1")
Set Rng = ws.Range("DM194:DO358")

ReDim MyArr2(0 To 2)
MyArr1 = Array(1, 13, 14)
With ws
For x = 13 To 130
If fn.CountA(.Cells(x, 13), .Cells(x, 14)) Then
For y = 0 To 2
MyArr2 = .Cells(x, MyArr1)
Next y

For z = 194 To 358
If fn.CountA(.Cells(z, 117), .Cells(z, 118), .Cells(z, 119)) = 0 Then
.Range(.Cells(z, 117), .Cells(z, 119)) = MyArr2
Exit For
End If
Next z
ReDim MyArr2(0 To 2)
End If
Next x
End With

Rng.Sort _
Key1:=Range("DM194"), Order1:=xlAscending, _
Key2:=Range("DN194"), Order2:=xlAscending, _
Key3:=Range("DO194"), Order3:=xlAscending, _

End Sub</pre>

Jay: Thanks for your time! I've tested it and it's great. It has one error:
RunTime 1004 ---Sort method of Range class failed.
Highlighed in yellow: from the line "Rng.Sort" thru the line "Header:=x1No"

Copying: All of the rows copied over to DM, DN & DO correctly.
Sorting: Rows were sorted by month but failed to sort by day.

(Rows should sort only by DM which is a date (mmddyy e.g. 03/09/02).)

I understand almost nothing of your code. But it's great! I really, really appreciate your help. When this is finished, the only thing it won't do is whinny like a horse! (The spreadsheet is to help out a good friend who is a horse trainer.)

Steve

that's not

x1no (CAPS X1NO)

should be

xlNo (CAPS XLNO)

Hi,

I hope that Juan Pablo's suggestion corrected the error you were receiving and that the routine is running, as I did not receive the error in my tests.

I have added to the code to show only the unique values. Again, please test this and report your results.

<pre>Sub test()
Dim x As Integer, y As Integer, z As Integer
Dim ws As Worksheet
Dim MyArr1
Dim MyArr2
Dim MyArr3
Dim MyArr4
Dim Rng As Range, Rng2 As Range, Rng3 As Range
Dim Counter As Long, CompareString As String
Dim fn As WorksheetFunction

Set fn = Application.WorksheetFunction
Set ws = ThisWorkbook.Sheets("Sheet1")
Set Rng = ws.Range("DM194:DO358")

ReDim MyArr2(0 To 2)
MyArr1 = Array(1, 13, 14)

With ws
For x = 13 To 130
If fn.CountA(.Cells(x, 13), .Cells(x, 14)) Then
For y = 0 To 2
MyArr2 = .Cells(x, MyArr1)
Next y

For z = 194 To 358
If fn.CountA(.Cells(z, 117), .Cells(z, 118), .Cells(z, 119)) = 0 Then
.Range(.Cells(z, 117), .Cells(z, 119)) = MyArr2
Exit For
End If
Next z
ReDim MyArr2(0 To 2)
End If
Next x

Rng.Sort _
Key1:=Range("DM194"), Order1:=xlAscending, _
Key2:=Range("DN194"), Order2:=xlAscending, _
Key3:=Range("DO194"), Order3:=xlAscending, _

Set Rng2 = Intersect(Rng, .UsedRange)
For x = 1 To Rng2.Rows.Count
CompareString = _
.Cells(x + Rng2.Row - 1, 117) & "|" & _
.Cells(x + Rng2.Row - 1, 118) & "|" & _
.Cells(x + Rng2.Row - 1, 119)

If IsError(Application.Match(CompareString, MyArr3, 0)) Then
Counter = Counter + 1
If Counter = 1 Then
ReDim MyArr3(1 To Counter)
ReDim MyArr4(1 To Counter)
Else
ReDim Preserve MyArr3(1 To Counter)
ReDim Preserve MyArr4(1 To Counter)
End If
MyArr3(Counter) = CompareString
MyArr4(Counter) = Intersect(Rng2, .Rows(x + Rng2.Row - 1))
End If
Next x
Rng2.ClearContents
For x = 1 To Counter
.Cells(x + Rng2.Row - 1, 117).Resize(1, 3) = MyArr4(x)
Next x
End With

End Sub</pre>

This code could be structured better, but we can refine it when it does as you want.

Jay,
Juan Pablo's correction was good - but I only made the mistake in my reply - the code was still correct. The error still occurs.

I will use the new code and reply shortly.
Thank you.
Steve

Jay,
I've tested your new version (9/20 10:10). Identical results to previous: RunTime 1004 ---Sort method of Range class failed.
Only sorts months, not day or year. The code for the unique values doesn't get a chance to run. The only thing I changed was "Sheet1" to "2002" (and the sub name). Highlighted code below (copy-paste):

Rng.Sort _
Key1:=Range("DM194"), Order1:=xlAscending, _
Key2:=Range("DN194"), Order2:=xlAscending, _
Key3:=Range("DO194"), Order3:=xlAscending, _

Sample of result (also same order as source):
....DM........DN........DO
03/03/02 . 26.3 . 162.3
03/02/02 . 26.2 . 162.2
03/01/02 . 26.1 . 162.1
03/04/02 . 26.4 . 162.4
...

Steve
This message was edited by SteveC on 2002-09-20 11:25

Hi,

Comment out the problem code and then run the report. It will not be sorted, but you should only show the unique values (we hope!) in the destination range.

Jay,
Duplicate suppression code works perfectly!
Steve

Jay,
I've been looking for another way to sort - but haven't found anything (that I can understand). Do you think that the commented-out problem code can still work or is any sorting out of the question in my case? The fact that it sorts the month before it quits seemed encouraging. I should have learned VBA long ago.
Thanks
Steve

Replies
0
Views
509
Replies
4
Views
452
Replies
4
Views
407
Replies
3
Views
774
Replies
17
Views
3K

1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

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

### Which adblocker are you using?

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

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