Hi,

I have a code with selects a list and finds a date. Then it works in that column. In case a particular date is missing, the code moves to an error handler which adds 1 to the date to that the code looks for the next date. This works the first time but fails the second time. Why is this happening? The code is below.

<code>
Dim dte As Date

Sheets("Inputs").Select
Range("AO6").Select

Do Until IsEmpty(ActiveCell) = True

If IsEmpty(ActiveCell.Offset(1, 0)) = False Then
ActiveCell.Offset(0, 2).Select

Else:

dte = ActiveCell

b = ActiveCell.Column

Sheets("Inputs").Range("BP7").Activate

Sheets("Records").Select
Range("E7").Select
Range(Selection, Selection.End(xlToRight)).Select
repeat1:
On Error GoTo errhandler

Selection.Find(What:=dte, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select

Do Until Month(ActiveCell.Offset(-1, 0)) = Month(dte) = False

Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Inputs").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Offset(1, 0).Select
Sheets("Records").Select
ActiveCell.Offset(0, 1).Activate

Loop

Application.CutCopyMode = False

Sheets("Inputs").Select
Range("BP7").Activate

Range("BP7").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Cells(7, b).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=Array(1), Header:= _
xlNo
ActiveCell.Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = "=COUNTIF(R7C68:R10000C68,RC[-1])"
Selection.Copy
Range(ActiveCell, ActiveCell.Offset(ActiveCell.Offset(-2, -1).Value - 1, 0)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

ActiveCell.Offset(-1, 1).Select

End If

Sheets("Inputs").Range("BP7:BP10000").ClearContents

Loop


Exit Sub

errhandler:

dte = dte + 1
GoTo repeat1

End Sub
</code>