Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub

See if this does what you need.

Regards,
Bill



Sub LFmacro()

Dim nRows As Long
Dim i As Long
Dim Source As Range
Dim strCheckDate As String
Dim datCheck As Date
Dim datLatest As Date

'ChDir "G:\Lou French macro"
'Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nRows = Cells.SpecialCells(xlCellTypeLastCell).Row

' Loop one time to find the latest date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

If (datLatest < datCheck) Then datLatest = datCheck
End If
Next i

strCheckDate = Format(datLatest, "m/d/yyyy")

' Loop a second time to find all occurences of this date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
If (Format(Cells(i, 3).Value, "m/d/yyyy") = strCheckDate) Then
If (Source Is Nothing) Then
Set Source = Cells(i, 3).EntireRow
Else
Set Source = Union(Source, Cells(i, 3).EntireRow)
End If
End If
End If
Next i

If (Source Is Nothing) Then
Call MsgBox("no dates found")
Exit Sub
End If

Source.Copy
Windows("LFmacro.XLS").Activate
Cells(Rows.Count, 3).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste

End Sub


"Meltad" wrote:

Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub

Hi Bill,

I tried this but got an error quite early on (on this line)...
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

My date is in this format in the spreadsheet d/m/yy so I changed all your
"m/d/yyyy" to "d/m/yy" but this didn't solve it.


"Bill Pfister" wrote:

See if this does what you need.

Regards,
Bill



Sub LFmacro()

Dim nRows As Long
Dim i As Long
Dim Source As Range
Dim strCheckDate As String
Dim datCheck As Date
Dim datLatest As Date

'ChDir "G:\Lou French macro"
'Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nRows = Cells.SpecialCells(xlCellTypeLastCell).Row

' Loop one time to find the latest date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

If (datLatest < datCheck) Then datLatest = datCheck
End If
Next i

strCheckDate = Format(datLatest, "m/d/yyyy")

' Loop a second time to find all occurences of this date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
If (Format(Cells(i, 3).Value, "m/d/yyyy") = strCheckDate) Then
If (Source Is Nothing) Then
Set Source = Cells(i, 3).EntireRow
Else
Set Source = Union(Source, Cells(i, 3).EntireRow)
End If
End If
End If
Next i

If (Source Is Nothing) Then
Call MsgBox("no dates found")
Exit Sub
End If

Source.Copy
Windows("LFmacro.XLS").Activate
Cells(Rows.Count, 3).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste

End Sub


"Meltad" wrote:

Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub

When you're on the line that breaks, go to the immediate window with this
line "?Cells(i, 3).Value" and let me know what it returns.


"Meltad" wrote:

Hi Bill,

I tried this but got an error quite early on (on this line)...
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

My date is in this format in the spreadsheet d/m/yy so I changed all your
"m/d/yyyy" to "d/m/yy" but this didn't solve it.


"Bill Pfister" wrote:

See if this does what you need.

Regards,
Bill



Sub LFmacro()

Dim nRows As Long
Dim i As Long
Dim Source As Range
Dim strCheckDate As String
Dim datCheck As Date
Dim datLatest As Date

'ChDir "G:\Lou French macro"
'Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nRows = Cells.SpecialCells(xlCellTypeLastCell).Row

' Loop one time to find the latest date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

If (datLatest < datCheck) Then datLatest = datCheck
End If
Next i

strCheckDate = Format(datLatest, "m/d/yyyy")

' Loop a second time to find all occurences of this date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
If (Format(Cells(i, 3).Value, "m/d/yyyy") = strCheckDate) Then
If (Source Is Nothing) Then
Set Source = Cells(i, 3).EntireRow
Else
Set Source = Union(Source, Cells(i, 3).EntireRow)
End If
End If
End If
Next i

If (Source Is Nothing) Then
Call MsgBox("no dates found")
Exit Sub
End If

Source.Copy
Windows("LFmacro.XLS").Activate
Cells(Rows.Count, 3).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste

End Sub


"Meltad" wrote:

Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub

Hi Bill,

Sorry I don't understand what you mean by this? What exactly do you want me
to do?

Mel


"Bill Pfister" wrote:

When you're on the line that breaks, go to the immediate window with this
line "?Cells(i, 3).Value" and let me know what it returns.


"Meltad" wrote:

Hi Bill,

I tried this but got an error quite early on (on this line)...
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

My date is in this format in the spreadsheet d/m/yy so I changed all your
"m/d/yyyy" to "d/m/yy" but this didn't solve it.


"Bill Pfister" wrote:

See if this does what you need.

Regards,
Bill



Sub LFmacro()

Dim nRows As Long
Dim i As Long
Dim Source As Range
Dim strCheckDate As String
Dim datCheck As Date
Dim datLatest As Date

'ChDir "G:\Lou French macro"
'Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nRows = Cells.SpecialCells(xlCellTypeLastCell).Row

' Loop one time to find the latest date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

If (datLatest < datCheck) Then datLatest = datCheck
End If
Next i

strCheckDate = Format(datLatest, "m/d/yyyy")

' Loop a second time to find all occurences of this date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
If (Format(Cells(i, 3).Value, "m/d/yyyy") = strCheckDate) Then
If (Source Is Nothing) Then
Set Source = Cells(i, 3).EntireRow
Else
Set Source = Union(Source, Cells(i, 3).EntireRow)
End If
End If
End If
Next i

If (Source Is Nothing) Then
Call MsgBox("no dates found")
Exit Sub
End If

Source.Copy
Windows("LFmacro.XLS").Activate
Cells(Rows.Count, 3).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste

End Sub


"Meltad" wrote:

Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub

When the code execution breaks, press the "Debug" button and it will take you
to the visual basic editor. From there, press Ctrl-G to go to the Immediate
Window. In the Immediate Window, enter this line (without the quotation
marks) "?Cells(i, 3).Value" and press Enter. After pressing enter, there
should be a result below the line you typed/pasted - let me know what that
result is. I am curious to know whether the value contained in Cells(i, 3)
is valid.



"Meltad" wrote:

Hi Bill,

Sorry I don't understand what you mean by this? What exactly do you want me
to do?

Mel


"Bill Pfister" wrote:

When you're on the line that breaks, go to the immediate window with this
line "?Cells(i, 3).Value" and let me know what it returns.


"Meltad" wrote:

Hi Bill,

I tried this but got an error quite early on (on this line)...
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

My date is in this format in the spreadsheet d/m/yy so I changed all your
"m/d/yyyy" to "d/m/yy" but this didn't solve it.


"Bill Pfister" wrote:

See if this does what you need.

Regards,
Bill



Sub LFmacro()

Dim nRows As Long
Dim i As Long
Dim Source As Range
Dim strCheckDate As String
Dim datCheck As Date
Dim datLatest As Date

'ChDir "G:\Lou French macro"
'Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nRows = Cells.SpecialCells(xlCellTypeLastCell).Row

' Loop one time to find the latest date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
datCheck = Format(Cells(i, 3).Value, "m/d/yyyy")

If (datLatest < datCheck) Then datLatest = datCheck
End If
Next i

strCheckDate = Format(datLatest, "m/d/yyyy")

' Loop a second time to find all occurences of this date
For i = 1 To nRows
If (Len(Cells(i, 3).Value) 0) Then
If (Format(Cells(i, 3).Value, "m/d/yyyy") = strCheckDate) Then
If (Source Is Nothing) Then
Set Source = Cells(i, 3).EntireRow
Else
Set Source = Union(Source, Cells(i, 3).EntireRow)
End If
End If
End If
Next i

If (Source Is Nothing) Then
Call MsgBox("no dates found")
Exit Sub
End If

Source.Copy
Windows("LFmacro.XLS").Activate
Cells(Rows.Count, 3).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste

End Sub


"Meltad" wrote:

Hi,
I'm trying to copy rows from one workbook to another - all those rows which
have the most recent date (date in column c).
Tom Ogilvy supplied this code for me but it just copies one row not all
instances of that date, any ideas???


"Tom Ogilvy" wrote:

Sub LFmacro()

Dim nRows As Long
Dim i as Long
Dim Source as Range

ChDir "G:\Lou French macro"
Workbooks.Open Filename:="G:\Lou French macro\podnondel.CSV"

'copy latest date from podnondel workbook
'colour rows red

nrows = Application.CountA(Columns(3))
i = 1
Do While Cells(nrows, 3).Offset(-i, 0).Value = Cells(nrows, 3).Value
i = i + 1
Loop
Set Source = Cells(nrows, 3).Offset(-1 * (i - 1), 0).Resize(i).EntireRow
Source.Copy
Windows("LFmacro.XLS").Activate
cells(rows.count,3).End(xlup).offset(1,-2).Select
ActiveSheet.Paste

End Sub