VBA macro - While loop with a formula until a condition is met for every cell in a column

JkJkJake

New Member
Joined
Dec 3, 2019
Messages
2
Office Version
365
Platform
Windows
I would like some help with a piece of VBA code :)

Problem: Add 'Periodicity' values (with a nested if statement) to the 'Draft date' until the date is greater than or equal to the 'Cut off date'. Repeat for all cells in a column.

Referring to the example image: In cell S28 (5/09/2019), it has applied the formula of 'P28+14' but the adjusted date (19/09/2019) is still less than the cut off date (of 25/11/2019). The macro should repeat this periodicity formula until the adjusted date reaches 28/11/2019 (5 additional iterations).

I have tried using a Do While loop where values in the 'Change baseline' loop while the value is still "Yes"... but I was not successful due to my lack of VBA experience.

Example Periodicity formula in cell S4:
=IF($G4="Weekly",P4+7,IF($G4="Fortnightly",P4+14,IF($G4="Monthly",EDATE(P4,1),IF($G4="2-Monthly",EDATE(P4,2),IF($G4="Quarterly",EDATE(P4,3),IF($G4="6-Monthly",EDATE(P4,6),"No"))))))

Example Periodicity formula in VBA:
"=IF(RC7=""Weekly"",RC[-3]+7,IF(RC7=""Fortnightly"",RC[-3]+14,IF(RC7=""Monthly"",EDATE(RC[-3],1),IF(RC7=""2-Monthly"",EDATE(RC[-3],2),IF(RC7=""Quarterly"",EDATE(RC[-3],3),IF(RC7=""6-Monthly"",EDATE(RC[-3],6),""No""))))))"

Thank you in advance for any help, please ask for any further clarification if needed!

Example image:

1575421696169.png
 

QuietRiot

Well-known Member
Joined
May 18, 2007
Messages
997
Code:
Sub UpdateAdjustedDates()
    Dim CutoffDate As Date, DraftDate As Date, AdjustedDate As Date
    Dim Periodicity As String
    Dim LastRowP As Long, i As Long
    
    'Get cut-off date
    CutoffDate = Range("P1").Value
    
    'Get the last row in column P
    With ActiveSheet
        LastRowP = .Cells(.Rows.Count, "P").End(xlUp).Row
    End With
    
    For i = 4 To LastRowP
        'Get Draft date
        DraftDate = Range("P" & i).Value
        'Set Adjusted
        AdjustedDate = DraftDate
        'Get periodicity
        Periodicity = Range("Q" & i).Value
        
        Do While AdjustedDate < CutoffDate
            Select Case Periodicity
                Case "Weekly"
                    AdjustedDate = AdjustedDate + 7
                Case "Fortnightly"
                    AdjustedDate = AdjustedDate + 14
                Case "Monthly"
                    AdjustedDate = Worksheet.Function.EDate(AdjustedDate, 1)
                Case "2-Monthly"
                    AdjustedDate = Worksheet.Function.EDate(AdjustedDate, 2)
                Case "Quarterly"
                    AdjustedDate = Worksheet.Function.EDate(AdjustedDate, 3)
                Case "6-Monthly"
                    AdjustedDate = Worksheet.Function.EDate(AdjustedDate, 6)
            End Select
        Loop
        
        'Add new Adjusted date
        Range("S" & i).Formula = AdjustedDate
        
    Next

End Sub
 
Last edited:

QuietRiot

Well-known Member
Joined
May 18, 2007
Messages
997
some errors with the worksheet function. Should be..

Code:
Sub GetAdjustedDates()
    Dim CutoffDate As Date, DraftDate As Date, AdjustedDate As Date
    Dim Periodicity As String
    Dim LastRowP As Long, i As Long
    
    'Get cut-off date
    CutoffDate = Range("P1").Value
    
    'Get the last row in column P
    With ActiveSheet
        LastRowP = .Cells(.Rows.Count, "P").End(xlUp).Row
    End With
    
    For i = 4 To LastRowP
        'Get Draft date
        DraftDate = Range("P" & i).Value
        'Set Adjusted
        AdjustedDate = DraftDate
        'Get periodicity
        Periodicity = Range("Q" & i).Value
        
        Do While AdjustedDate < CutoffDate
            Select Case Periodicity
                Case "Weekly"
                    AdjustedDate = AdjustedDate + 7
                Case "Fortnightly"
                    AdjustedDate = AdjustedDate + 14
                Case "Monthly"
                    AdjustedDate = CDate(Application.WorksheetFunction.EDate(AdjustedDate, 1))
                Case "2-Monthly"
                    AdjustedDate = CDate(Application.WorksheetFunction.EDate(AdjustedDate, 2))
                Case "Quarterly"
                    AdjustedDate = CDate(Application.WorksheetFunction.EDate(AdjustedDate, 3))
                Case "6-Monthly"
                    AdjustedDate = CDate(Application.WorksheetFunction.EDate(AdjustedDate, 6))
            End Select
        Loop
        
        'Add new Adjusted date
        Range("S" & i).Formula = AdjustedDate
        
    Next

End Sub
 

Forum statistics

Threads
1,078,401
Messages
5,339,998
Members
399,347
Latest member
chlearning

Some videos you may like

This Week's Hot Topics

Top