Jay Petrulis (reporting back)

[SteveC]

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

 

[Jay Petrulis]

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, _
Header:=xlNo

End Sub</pre>

 

[SteveC]

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

 

[Juan Pablo González]

that's not

x1no (CAPS X1NO)

should be

xlNo (CAPS XLNO)

 

[Jay Petrulis]

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, _
Header:=xlNo

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.

 

[SteveC]

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

 

[SteveC]

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, _
Header:=xlNo

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

Thanks for your time.
Steve
This message was edited by SteveC on 2002-09-20 11:25

 

[Jay Petrulis]

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.

 

[SteveC]

Jay,
Duplicate suppression code works perfectly!
Steve

 

[SteveC]

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