View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Mike Mike is offline
external usenet poster
 
Posts: 3,101
Default date code error, help would be appreciated!

morning,

i having some issues with the below code.
it is supposed to search for the date today minus 12 months, and then copy
all rows in between to a new sheet.
any suggestions would be greatly appreciated!
thanks very much on this very cold and foggy morning!!
mike

Private Sub CommandButton2_Click()
Dim Rng As range
Dim rCell As range
Dim copyRng As range
Dim destRng As range
Dim mydate As Date
Dim sh As Worksheet
Dim CalcMode As Long
Dim arr As Variant
Dim res As Variant
Dim mymonth As Date


mydate = Date
mymonth = Month(mydate)
Set sh = Sheets("Sheet 1")
Set Rng = sh.range("A5:A100")
Set destRng = Sheets("Sheet 2").range("A2")

res = mydate - mymonth

If res = "" Then Exit Sub
arr = Split(res, " ")

With application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


For Each rCell In Rng.Cells
If Not IsError(application.Match(rCell.Value, arr, 0)) Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

With application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub