I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Just reset the code and tried again.
This time, although I still get the same error message (line 26), there are
three X's as expected in the first three rows in IV.


--
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Got further down now to line 36 - .Rows(Newrow).Paste

Also, how do I get the auto filter to revert back to how it was originally
(ie with no filter) once rows have been copied over?
--
Traa Dy Liooar

Jock


"Joel" wrote:

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Mot sure why but had to use pastespecial instead of paste. Also added the
removal of the autofilter.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy

End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15
.Columns("IV").AutoFilter
End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub

"Jock" wrote:

Got further down now to line 36 - .Rows(Newrow).Paste

Also, how do I get the auto filter to revert back to how it was originally
(ie with no filter) once rows have been copied over?
--
Traa Dy Liooar

Jock


"Joel" wrote:

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Nice one - many thanks Joel.
One last thing, can the PasteValues part be adapted to include formatting
from sheet!1? The reason being that there are dates and other stuff formatted
in different ways which I'd like copied accross too.

Thanks again.

--
Traa Dy Liooar

Jock


"Joel" wrote:

Mot sure why but had to use pastespecial instead of paste. Also added the
removal of the autofilter.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy

End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15
.Columns("IV").AutoFilter
End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub

"Jock" wrote:

Got further down now to line 36 - .Rows(Newrow).Paste

Also, how do I get the auto filter to revert back to how it was originally
(ie with no filter) once rows have been copied over?
--
Traa Dy Liooar

Jock


"Joel" wrote:

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

from
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
to
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteFormats


"Jock" wrote:

Nice one - many thanks Joel.
One last thing, can the PasteValues part be adapted to include formatting
from sheet!1? The reason being that there are dates and other stuff formatted
in different ways which I'd like copied accross too.

Thanks again.

--
Traa Dy Liooar

Jock


"Joel" wrote:

Mot sure why but had to use pastespecial instead of paste. Also added the
removal of the autofilter.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy

End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15
.Columns("IV").AutoFilter
End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub

"Jock" wrote:

Got further down now to line 36 - .Rows(Newrow).Paste

Also, how do I get the auto filter to revert back to how it was originally
(ie with no filter) once rows have been copied over?
--
Traa Dy Liooar

Jock


"Joel" wrote:

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock

Cool, Thanks :)
--
Traa Dy Liooar

Jock


"Joel" wrote:

from
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
to
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteFormats


"Jock" wrote:

Nice one - many thanks Joel.
One last thing, can the PasteValues part be adapted to include formatting
from sheet!1? The reason being that there are dates and other stuff formatted
in different ways which I'd like copied accross too.

Thanks again.

--
Traa Dy Liooar

Jock


"Joel" wrote:

Mot sure why but had to use pastespecial instead of paste. Also added the
removal of the autofilter.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy

End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).PasteSpecial _
Paste:=xlPasteValues
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15
.Columns("IV").AutoFilter
End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub

"Jock" wrote:

Got further down now to line 36 - .Rows(Newrow).Paste

Also, how do I get the auto filter to revert back to how it was originally
(ie with no filter) once rows have been copied over?
--
Traa Dy Liooar

Jock


"Joel" wrote:

made a typo on Lasdt line in a few places. I also added the delete of
column IV at the end.

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV" & Rows.Count).End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With

With Sheets("Sheet1")
.Columns("IV").Delete
End With

End Sub


"Jock" wrote:

Hi Joel,
This looks very promising!
I have received an "Application-defined or object-defined error" though, on
line 26 - LastRow = .Range("IV").End(xlUp).Row - can't see why tho.
Could it be because the offset dates span three columns depending on which
of A, B or C the words were found in?
Only the first row has an X in column IV ( although I expected an X to
appear in the second and third rows too as there was dummy data in A, B and C)

Thanks
Traa Dy Liooar

Jock


"Joel" wrote:

Sub RunOnceADay()

wordlist = Array("black", "white", "green")

With Sheets("Sheet1")
'use column IV as a filter to indicate rows that have changed
.Columns("IV").Delete
For Each wd In wordlist
Set c = .Columns("A:C").Find(what:=wd, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

firstaddr = c.Address
Do
If c.Offset(0, 22) = "" Then
c.Offset(0, 22) = Date
'put an x in column IV for rows with todays date
.Range("IV" & c.Row) = "X"
End If

Loop While Not c Is Nothing And c.Address < firstaddr
End If
Next wd
'filter on column IV containing a "X"
LastRow = .Range("IV").End(xlUp).Row
.Columns("IV").AutoFilter Field:=1, Criteria1:="X"
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("Sheet2")
LastRow = .Range("A").End(xlUp).Row
Newrow = LastRow + 1
.Rows(Newrow).Paste
LastRow = .Range("A").End(xlUp).Row
.Rows(Newrow & ":" & LastRow).Interior.ColorIndex = 15

End With


End Sub


"Jock" wrote:

I'm still trying to sort this one out - but using a new approach.

Once every few days, I want a user to click a button which will run a macro
which will:
check columns A:C for certain words (black, white, green).

If any of these words are found in any row, to then enter today's date in a
cell on the same row offset by (0 ,22) unless that cell already has a date in
it from a previous running of this macro

To then search the column with the offset dates for 'todays' date and copy
the entire row to Sheet!2 but only those rows which have the same date as
'today'.

To colour all rows copied over grey so they stand out (or put a bold line at
the top of the first row to be copied over).

I hope this makes sense as I have been struggling for a while now. :)
--
Traa Dy Liooar

Jock