Jay Petrulis (reporting back)

SteveC

Board Regular
Joined
Mar 14, 2002
Messages
118
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

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Jay Petrulis

MrExcel MVP
Joined
Mar 17, 2002
Messages
2,040
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(y) = .Cells(x, MyArr1(y))
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

Board Regular
Joined
Mar 14, 2002
Messages
118
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
 

Jay Petrulis

MrExcel MVP
Joined
Mar 17, 2002
Messages
2,040

ADVERTISEMENT

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(y) = .Cells(x, MyArr1(y))
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

Board Regular
Joined
Mar 14, 2002
Messages
118
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

Board Regular
Joined
Mar 14, 2002
Messages
118

ADVERTISEMENT

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

MrExcel MVP
Joined
Mar 17, 2002
Messages
2,040
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

Board Regular
Joined
Mar 14, 2002
Messages
118
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
 

Forum statistics

Threads
1,144,739
Messages
5,726,006
Members
422,652
Latest member
Elnene1

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top