Formula for subtracting from a total, if a specific item is selected from a dropdown

[angdilla]

Hello! Is there a way to automatically subtract 1 from a cell when an item is selected from a dropdown? I have a specific number of times I can use each item in the dropdown menu and would like to keep track of how many remaining times are available for each item.

Thank you!

 

[angdilla]

Click here to download your file. I have had to remove trailing spaces in some of the Fund names in columns A and I of the Funds Available sheet. I have also added WMALDOC-E and WMALDOC-H to the Fund Codes sheet to update the drop downs and also in column A of the Funds Available sheet. Simply make a selection in the drop downs in the Grants sheet. The macro is in the code module for the Grants sheet. To view the code, right click the tab name for your Grants sheet and click 'View Code'. Close the code window to return to your sheet. This is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim lRowG As Long, lRowFA As Long, fund As Range
    lRowG = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("I7:W" & lRowG)) Is Nothing Then Exit Sub
    lRowFA = Sheets("Funds Available").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set fund = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
    fund.Offset(, 5).Copy
    If Not fund Is Nothing Then
        fund.Offset(, 6).Value = fund.Offset(, 6).Value - 1
    End If
    Application.ScreenUpdating = False
End Sub

I'm back again. If I choose an item from the dropdown, move on, and then want to change the original dropdown to something else, it does not add 1 back to the total once the original code is removed. Is that possible?

 

[mumps]

Replace the current code with this:

Dim val As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    val = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim lRowG As Long, lRowFA As Long, fund As Range, fund2 As Range
    lRowG = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("I7:W" & lRowG)) Is Nothing Then Exit Sub
    lRowFA = Sheets("Funds Available").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target <> "" Then
        Set fund = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If val = "" Then
            fund.Offset(, 6).Value = fund.Offset(, 6).Value - 1
        ElseIf Target.Value <> val Then
            Set fnd2 = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(val, LookIn:=xlValues, lookat:=xlWhole)
            fnd2.Offset(, 6).Value = fnd2.Offset(, 6).Value + 1
            fund.Offset(, 6).Value = fund.Offset(, 6).Value - 1
        End If
    Else
        Set fund = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(val, LookIn:=xlValues, lookat:=xlWhole)
        fund.Offset(, 6).Value = fund.Offset(, 6).Value + 1
    End If
    Range("A2").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
End Sub

 

[angdilla]

Replace the current code with this:

Dim val As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    val = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim lRowG As Long, lRowFA As Long, fund As Range, fund2 As Range
    lRowG = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("I7:W" & lRowG)) Is Nothing Then Exit Sub
    lRowFA = Sheets("Funds Available").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target <> "" Then
        Set fund = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If val = "" Then
            fund.Offset(, 6).Value = fund.Offset(, 6).Value - 1
        ElseIf Target.Value <> val Then
            Set fnd2 = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(val, LookIn:=xlValues, lookat:=xlWhole)
            fnd2.Offset(, 6).Value = fnd2.Offset(, 6).Value + 1
            fund.Offset(, 6).Value = fund.Offset(, 6).Value - 1
        End If
    Else
        Set fund = Sheets("Funds Available").Range("A2:A" & lRowFA, "I2:I" & lRowFA).Find(val, LookIn:=xlValues, lookat:=xlWhole)
        fund.Offset(, 6).Value = fund.Offset(, 6).Value + 1
    End If
    Range("A2").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
End Sub

You're a hero!

 

[mumps]

Glad to help.