Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Search & Copy macro - help

Status
Not open for further replies.

dacllog

Technical User
Mar 21, 2007
18
DK
Hi,

In Excel I have a column with different item numbers, like this:

112004 12-01-2007
112004 27-05-2007
113204 01-02-2007
113357 01-03-2007

Each row with item number contains som data (eg. date). I need help to a macro that should take the latest date for each unique item number and then copy the entire row to another sheet called "import".

I've tried to work the following macro intro... but I seem to be stuck!..??
While Cells(Cur_Row, Cur_Col).Value = Cells(Cur_Row + 1, Cur_Col).Value...


Thanks!
 
It's not clear from your post whether the Item Numbers and Dates are in different columns. They should be.

Assuming that they are, do you need to do this in VBA? Why not sort on Item Number (primary key) and Date (secondary key; ascending).

OK. I guess now you need VBA if you want to automatically export the latest row in each Item Number.

First find the range of rows; either you know it a priori or you have to determine it. There are plenty of threads here that show you how to find the last used row in a particular column. So let's assume you have established that you're looking at rows i through j.

First set a date variable to the first date (they're sorted in order now, right?):
date1 = cells(i,1).value
Now loop through i+1 to j looking for a change:
Code:
for l = i+1 to j
   if cells(l,1).value <> date1 then
      sheets("import").rows(x1) = <this sheet>.rows(l-1)
      x1 = x1 + 1
      date1 = cells(l,1).value
   end if
next
Note: you will have set x1 initially outside this loop.

_________________
Bob Rashkin
 




You ought to be able to use the AutoFilter to narrow your selection, copy the visible cells and paste in the import sheet.

Skip,
[sub]
[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue][/sub]
 
... or use pivot table: first column as row field, second column as data field (with 'max' as domain aggregation function, formatted as date).

combo
 
The Autofilter and pivot options doesn't work.

The rows are sorted after item number and date. I have about 28000 rows. My code now looks like this:

Sheets("import").Delete
'add sheet
Sheets.Add.Name = "import"
'select sheet
Sheets("Daniel_Test").Select
'determine how many rows
j = Sheets("Daniel_Test").Range("A65000").End(xlUp).Row
'set variables
x1 = 1
i = 2
date1 = Cells(i, 2).Value

'loop function
For l = i + 1 To j
If Cells(l, 2).Value <> date1 Then
Sheets("import").Rows("x1:x1") = _
Sheets("Daniel_Test").Rows("l - 1:l - 1")
x1 = x1 + 1
date1 = Cells(l, 2).Value
End If
Next

This doesn't work:) It gives me a mismatch alert at the "Sheets("import")...= - line.. so I'm stuck again.

A typical item number might look something like this(with item number and date i different columns):

100100 01-02-2007
100100 02-03-2007
100100 01-04-2007
100100 01-05-2007
100100 01-06-2007
100100 01-07-2007(*)

I need the macro to copy the latest date(*) row (the entire row) to the import sheet.

thanks!
 
Pivot table:
Does the table has headers? Are the dates stored as dates (after formatting as 'General' they should be displayed as numbers)?

Your code:
You usevariable name in string (Rows argument), whereas its value should be applied. Try:
...Rows(x1 & ":" & x1)
...Rows(l - 1 & ":" & l - 1)


combo
 
Hi combo,

Yes the table has headers, but the different item numbers have different "last dates". Not sure how to sort on that?


I'll try your code suggestion...
 
The code works without problem now... but it doesnt copy anything to the "import"-sheet? The loop code looks like this:

For l = i + 1 To j
If Cells(l, 2).Value <> date1 Then
Sheets("import").Rows(x1 & ":" & x1) = Sheets("Daniel_Test").Rows(l - 1 & ":" & l - 1)
x1 = x1 + 1
date1 = Cells(l, 2).Value
End If
Next

what am I doing wrong?
 
How do you store dates? See Skip's faq Why do Dates and Times seem to be so much trouble? faq68-5827

combo
 
They are stored as dates.. tried to store them as general, but not sure how this helps...?
 
'General' format is helpful for testing if there is serial number behind the date.
Concerning other tips, what do you mean by "The Autofilter and pivot options doesn't work"?

combo
 
The Autofilter and pivot options doesn't work (for me) for solving this problem.. if, I don't know how?

Do you know how? Or can u help me with the macro?
 
If you do not describe what you tried to do and what was the result, no one will help you. 'It doesn't work' means nothing here. I asked how do you store dates, with the way how to check it. It is still not clear for mw what you got.
What is the problem with pivot table? Can you create it? Have you changed aggregation function? If you get the wrong result, it may be linked with dates stored as string.

For me the following structure works:
Code:
Dim rSource As Range, vArray As Variant, rTarget As Range
Set rSource = Rows(SourceString)
vArray = rSource
Set rTarget = Rows(TargetString)
rTarget = vArray



combo
 
Hi Combo,

I found a solution that works:
For l = i + 1 To j
If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
ActiveSheet.Rows(i & ":" & i).Copy
Sheets("import").Select
Cells(x1, 1).Select


ActiveSheet.Paste


x1 = x1 + 1
Sheets("Daniel_Test").Select
End If
i = i + 1
Next

I could create the pivot table. What I meant was, that the pivot table solution didn't work for me cause I needed to copy the entire row (maybe I misunderstood something).

I didn't manage to understand how the Autofilter solution should be helpfull for me. But I thank you for giving me a usefull idea for the macro:)

Daniel
 
If you use SourceString=i & ":" & i and TargetString=x1 & ":" & x1 together with sheet references before Row, you could copy values without selecting (code from my previous post). This is much faster.

Alternatively, the Copy/Paste without selecting:
ActiveSheet.Rows(i & ":" & i).Copy Destination:=Sheets("import").Cells(x1, 1)

For copying entire rows pivot table is useless.

combo
 





"The Autofilter and pivot options doesn't work."

This usually means that you are NOT using Excel as it has been intended. These are tools that are extremely useful, but they do depend on a properly designed worksheets.

If you do not KNOW the features of Excel, you really should not be messing around with VBA. Learn Excel FIRST!

Skip,
[sub]
[glasses]Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top