Excel VBA Sum Rows by Date

Question

I have this code for summing several rows if the date is today. It works ok, but I have several worksheets, for example... Sheet 1, 2, 3, 4, 5. If I enter data in Sheet 1 and then run this code it works fine but if I enter data in sheet1 then skip sheet2 and go to 3 it zero's out what is in sheet2. I comment out the line near the bottom to exit sub if the date is less than today, but doing that the code dies. How can I make this run on ONLY the currently used sheet? I want to ignore all other sheets.

Sub Sum_TodaysDate()

On Error Resume Next

Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets

Dim LastRow As Long, iCount As Long
Dim icell As Range
Dim dSplit As Variant
Dim dIndex As Date

LastRow = sh.Range("D" & Rows.Count).End(xlUp).Row
iCount = 0

For Each icell In sh.Range("D2:D" & LastRow)
    dSplit = Split(icell.Value, " ")
    dIndex = Format(dSplit(0), "mm/dd/yyyy")
    If dIndex = Date Then
        iCount = iCount + 1
        icell.Offset(0, 1).Value = "|"
    End If
Next icell

'If sh.Range("E" & LastRow).Value < Date Then Exit Sub
sh.Range("E" & LastRow).Value = iCount
sh.Range("E" & LastRow).Font.Color = vbRed


Next sh

Application.ScreenUpdating = False

End Sub

Answer 1

Replace:

For Each sh In ActiveWorkbook.Worksheets

with:

Set sh = ActiveSheet

then remove:

Next sh