Hi,

I'm new to VBA andI'm having trouble writing a macro to copy rows based on
todays date. I have a macro that inserts todays date in column "P" of sheet1
whenever a change is done on the row. now i'm trying to write a macro that
will, when i save the file, check that column for all entries with todays
date and insert the row from columns A:K on sheet4 in row 2 moving everything
down and then deleting row 102 so i have a list of the last 100 changes with
the newest at the top. below is the attempt i made but it does not work. any
help would be appreciated greatly

Chris

Sub ItemChange()
'
' ItemChange Macro
' copies over any changes in upc list to "Last 100 Changes" on save
'
Sheet4.Range("A2:K" & Rows.Count).ClearContents
Datechk = Today
fLastRow = Sheet1.Range("P" & Rows.Count).End(xlUp).Row
For Each Datechk In Sheet1.Range("P1:P" & fLastRow)
If Date = Datechk Then
NxtRow = NxtRow + 1

Sheet4.Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.SmallScroll Down:=81
Rows("102:102").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-111
Sheet1.Range("A:K").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A2:K2").Select
Application.CutCopyMode = False
With Selection.Font
..Name = "Arial"
..Size = 10
..Strikethrough = False
..Superscript = False
..Subscript = False
..OutlineFont = False
..Shadow = False
..Underline = xlUnderlineStyleNone
..ColorIndex = xlAutomatic
..TintAndShade = 0
..ThemeFont = xlThemeFontNone
End With
Range("B2").Select
With Selection.Font
..Name = "Arial"
..Size = 8
..Strikethrough = False
..Superscript = False
..Subscript = False
..OutlineFont = False
..Shadow = False
..Underline = xlUnderlineStyleNone
..ColorIndex = xlAutomatic
..TintAndShade = 0
..ThemeFont = xlThemeFontNone
End With
Range("L2").Select
ActiveCell.FormulaR1C1 = Date


End If
Next

'


End Sub

Make sure that when you enter todays date in the column that it is not
including the time, even if the formating is set to date only the time will
still be included giving it a whole value for date and time hence date and
datechk will never be equal! this could be resolved by integerising the date.

"Code Flunkie" wrote:

Hi,

I'm new to VBA andI'm having trouble writing a macro to copy rows based on
todays date. I have a macro that inserts todays date in column "P" of sheet1
whenever a change is done on the row. now i'm trying to write a macro that
will, when i save the file, check that column for all entries with todays
date and insert the row from columns A:K on sheet4 in row 2 moving everything
down and then deleting row 102 so i have a list of the last 100 changes with
the newest at the top. below is the attempt i made but it does not work. any
help would be appreciated greatly

Chris

Sub ItemChange()
'
' ItemChange Macro
' copies over any changes in upc list to "Last 100 Changes" on save
'
Sheet4.Range("A2:K" & Rows.Count).ClearContents
Datechk = Today
fLastRow = Sheet1.Range("P" & Rows.Count).End(xlUp).Row
For Each Datechk In Sheet1.Range("P1:P" & fLastRow)
If Date = Datechk Then
NxtRow = NxtRow + 1

Sheet4.Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.SmallScroll Down:=81
Rows("102:102").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-111
Sheet1.Range("A:K").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A2:K2").Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("B2").Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("L2").Select
ActiveCell.FormulaR1C1 = Date


End If
Next

'


End Sub