Overall logic: determine number of days in a month. Loop through table (wsUploadTable) and increment value if condition is met. Loop to next day in month and repeat.

For example: 10/1/2016, loops through table for date match and increment value. Next date, 10/2/2016 loop table for match... until last day of month 10/31/2016, loop table, find match and increment value.

'Determine DaysinMonth and assign DaysinMonth_Distro value
DaysInMonth = DateSerial(dtTrickle_Year, dtTrickle_Month + 1, 1) - _
              DateSerial(dtTrickle_Year, dtTrickle_Month, 1)
DoM_Distro = 1 / DaysInMonth

ReDim Days(1 To DaysInMonth)
For i = 1 To DaysInMonth
    Days(i) = DateSerial(dtTrickle_Year, dtTrickle_Month, i)

  'loop table and increment cell value if condition is met

    With wsUploadTable
    lngER_PrimaryID = .Cells(1048576, 2).End(xlUp).Row
        For intPrimaryID = 2 To lngER_PrimaryID
            'store current cell value
            dblLeadsValue = .Cells(intPrimaryID, col_Upload_Leads)
            'match UploadTable row on user input and increment new value 
              If.Cells(intPrimaryID, 3).Value = Days(i) Then
              .Cells(intPrimaryID, 11).Value = dblLeadsValue + DoM_Distro
            End If
        Next 'Next PrimaryID
    End With
Next i
  • 2
    \$\begingroup\$ Welcome to CR! You've described your code well, but the code itself could use a bit more context; it would be nice to include the declarations for the variables you're using, and perhaps the procedure's signature as well (i.e. everything between Sub/Function and End Sub/Function - you see right now I'm not even sure I'm looking at a Sub or a Function, whether the involved variables are local or module-level, whether they're declared at all, and/or what else is in the same scope. \$\endgroup\$ Oct 8, 2016 at 0:04

2 Answers 2


Well havent tried either Excel or VBA , but the logic will go like this ,

  • Loop through the table
  • Say the date is day/month/year , where day,month and year are variables
  • lets have an array of months which is [31,28,31,30,31,30,31,31,30,31,30,31]
  • if year is divisible by 4 or 400 , then months[1]= months[1] + 1
  • now just display months[month]

Here months is the array and month is the number of month present in the date , for more info in arrays for VBA you can look here .


There's no need to remove 1st of next month from 1st of this month to get the number of days.

Day 0 in the DateSerial function is the last day of the previous month, so this will work:

DaysInMonth = Day(DateSerial(dtTrickle_Year, dtTrickle_Month + 1, 0))

It's leap-year sensitive to:
Day(DateSerial(2015, 2+ 1, 0)) returns 28.
Day(DateSerial(2016, 2+ 1, 0)) returns 29.

Looking further through your code I've made an attempt at coding what I think you're trying to do.
I've had to add some test values and variable declarations to make it work. It removes one of your loops by using the FIND method to go straight to the required cell.

Sub Test()

    Dim DaysInMonth As Long
    Dim DoM_Distro As Long
    Dim dtTrickle_Year As Long
    Dim dtTrickle_Month As Long
    Dim dblLeadsValue As Double
    Dim i As Long
    Dim dtCurrentDay As Date
    Dim rFound As Range

    dtTrickle_Year = 2016
    dtTrickle_Month = 2
    dblLeadsValue = 10

    'Determine DaysinMonth and assign DaysinMonth_Distro value
    DaysInMonth = Day(DateSerial(dtTrickle_Year, dtTrickle_Month + 1, 0))
    DoM_Distro = 1 / DaysInMonth

    'Cycle through each day in the month.
    For i = 1 To DaysInMonth
        dtCurrentDay = DateSerial(dtTrickle_Year, dtTrickle_Month, i)

        'Seach column 2 of the table to find the date value.
        With Range("wsUploadTable").Columns(2)
            'Find the value in the table.
            Set rFound = .Find( _
                What:=dtCurrentDay, _
                After:=.Cells(1, 1), _
                LookIn:=xlValues, _

            'Providing a value is found....
            If Not rFound Is Nothing Then
                'Place our result 10 columns to the right of the found cell.
                rFound.Offset(, 10).Value = dblLeadsValue + DoM_Distro
            End If
            Set rFound = Nothing
        End With
    Next i

End Sub

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.