CODEWITHSUNDEEP
vbaexcel
GingerbreadPK
GingerbreadPK

Reputation: 33

Apply VBA Macro Across Varying Cells?

Image of the SpreadSheet I am creating an Excel tracker for my work that determines when someone is within the secondary and primary zones of being promoted to the next rank. I started with Excel alone but that was too limited so I decided to try VBA which I have never used before. I currently have a script that reads what Rank the current individual is and then tells me the days they have from their Date of Rank, to the day they would be in the Primary or Secondary zones.

I can only do this for specific cells and I have to manually type in the date for their automatic promotion date. Is there a way to apply the same code along the whole sheet without having to manually change the cells. So if B2 contains the Rank of 'SPC' then F2 would have the days until the individual in that row has until they are in the Primary zone for 'SGT' and if B3 for example contains the Rank of 'PFC' then F3 would show the days until the individual is in the Primary zone for 'SPC' and so on.

Function Formula()
Workbook.Sheets("Sheet1").Range("F2").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")"
End Function

It's something like that for the Macros. I'm not at work so I can't know for sure.

The Code for the sheet itself is something like

Sub Workbook_Change(ByVal Target As Range)
macroName As String
If macroName = "PFC" Then
Application.Run Formula()
ElseIf macroName = "SPC" Then
Application.Run Formula2()
EndIf
End Sub

I've forgotten what else is there but it only works for specifically Row 2 and I would like to apply it to each row accordingly. B3 & F3, B4 & F4 etc. Other things I think I can figure out on my own would be automatically adjusting the Primary Zone ending based on Date of Rank rather than making it manual.

Upvotes: 0

Views: 107

Answers (1)

YowE3K
YowE3K

Reputation: 23994

Based on the code you have shown, it would be easier to include the code from Formula into the Worksheet_Change event itself, e.g.

Sub Worksheet_Change(ByVal Target As Range)
    Dim macroName As String
    macroName = "something"
    If macroName = "PFC" Then
        Application.EnableEvents = False
        Cells(Target.Row, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")"
        Application.EnableEvents = True
    ElseIf macroName = "SPC" Then
        Application.Run Formula2()
    EndIf
End Sub

This does assume that the sheet on which the changed cell exists is Sheets("Sheet1").

Note that Application.EnableEvents has been disabled prior to making a change to the sheet. This will stop Excel entering an infinite loop.

Alternatively, you could pass the changed cell as a parameter to Formula:

Function Formula(c As Range)
    Workbook.Sheets("Sheet1").Cells(c.Row, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")"
End Function

Sub Worksheet_Change(ByVal Target As Range)
    Dim macroName As String
    macroName = "something"
    If macroName = "PFC" Then
        Application.EnableEvents = False
        Formula Target
        Application.EnableEvents = True
    ElseIf macroName = "SPC" Then
        Formula2
    EndIf
End Sub

Or yet another way would be to just pass the row number of the changed cell as a parameter to Formula:

Function Formula(r As Long)
    Workbook.Sheets("Sheet1").Cells(r, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")"
End Function

Sub Worksheet_Change(ByVal Target As Range)
    Dim macroName As String
    macroName = "something"
    If macroName = "PFC" Then
        Application.EnableEvents = False
        Formula Target.Row
        Application.EnableEvents = True
    ElseIf macroName = "SPC" Then
        Formula2
    EndIf
End Sub

In order to calculate the correct date (and based on my first method of coding) you could do something like:

Sub Worksheet_Change(ByVal Target As Range)
    Dim macroName As String
    Dim mthsToAdd As Integer
    Dim apd As Date
    macroName = "something"
    If macroName = "PFC" Then
        Application.EnableEvents = False
        mthsToAdd = 3
        'Note: The following formula won't correctly handle cases such as
        '      adding two months to 30 December 2016 (it will calculate
        '      2 March 2017 in that case, due to "30 February 2017" being
        '      treated as "2 days after 28 February 2017")
        Cells(Target.Row, "F").FormulaR1C1 = "=DATEDIF(Today(),DATE(YEAR(RC4),MONTH(RC4)+" & mthsToAdd & ",DAY(RC4)),""d"")"

        'or, if your formula doesn't need to allow for future changes to column D 
        apd = DateAdd("m", mthsToAdd, Cells(Target.Row, "D").Value)
        Cells(Target.Row, "F").FormulaR1C1 = "=DATEDIF(Today(),""" & Format(apd, "mm/dd/yyyy") & """,""d"")"

        'or, if you don't even need to allow for future changes to "Today"
        apd = DateAdd("m", mthsToAdd, Cells(Target.Row, "D").Value)
        Cells(Target.Row, "F").Value = apd - Date()

        Application.EnableEvents = True
    ElseIf macroName = "SPC" Then
        Application.Run Formula2()
    EndIf
End Sub

Upvotes: 1

Related Questions