C
Code Flunkie
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
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
" & 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
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
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
" & 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