Data Validation With Additional Code

[jstevens]

I'm having a challenge with putting code behind "Data Validation".

As an example, when a cell is selected the EndUser sees a list of choices through "data validation". Based upon what is selected an amount associated with the choice is placed into the respective month.

untitled.png

I have been using the "Change Event" of the worksheet to incorporate my code but feel that there must be a better way. What I am seeing is a delay posting to the appropriate month.

Any ideas would be appreciated.

Thanks,
John

[HansV]

It looks like it should be possible to use formulas instead of VBA.
If not, the Worksheet_Change event would be the one to use. Do you check whether the changed cell is in the relevant range, or do you run the code regardless of which cells have been changed?

[jstevens]

Hans,

Within the Worksheet_Change event I'm focusing on the individual cell that changed ie the cell that the data validation updated. I know I can do it though a formula but depending upon the EndUser selection, there may be an amount that has to be entered in manually so a VBA solution would work best for me.

Regards,
John

[HansV]

In that case, you should indeed use the Worksheet_Change event. Without knowing the code, it's impossible to say more about it.

[jstevens]

Hans,

Here is the code I'm using.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

   If ActiveCell.Offset(0, 0).Column = 4 And ActiveCell.Offset(0, -1) <> "" Then
       Set af = Application.WorksheetFunction

       oRng = Sheets("Parameters").Range("R_TE")
       oRngTable = Sheets("Parameters").Range("R_TE_TABLE")

        x = ActiveCell
       Select Case x

       Case "Airfare Domestic - Coach"
           Range("F" & ActiveCell.Row & ":Q" & ActiveCell.Row) = 0
           GoSub Post_Cost
       End Select

   Else
       If ActiveCell.Offset(0, -1) = "" Then
           Range("F" & ActiveCell.Row & ":Q" & ActiveCell.Row) = 0
           MsgBox "Please Enter Travel Month"
               End
       End If
   End If
Sheets("T&E Input").EnableCalculation = True
Exit Sub

Post_Cost:
If ActiveCell.Offset(0, -1) <> "" Then
'Post to month
   oMonth = ActiveCell.Offset(0, -1)
   ActiveCell.Offset(0, 1 + oMonth) = af.Index(oRngTable, af.Match(x, oRng, 0), 3)
       End
Else
   MsgBox "Please Enter Travel Month"
End If

End Sub

Thanks for taking a look,
John

[HansV]

The code is rather chaotic, it's hard to follow what's happening. Here is a streamlined version:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim oCell As Range
  Dim oRng As Range
  Dim oRngTable As Range
  Dim af As WorksheetFunction
  Dim strValue As String
  Dim intMonth As Integer

  If Not Intersect(Range("D:D"), Target) Is Nothing Then
    For Each oCell In Intersect(Range("D:D"), Target)
      If oCell.Offset(0, -1) <> "" Then
        Range("F" & oCell.Row & ":Q" & oCell.Row) = 0
        Set af = Application.WorksheetFunction
        Set oRng = Sheets("Parameters").Range("R_TE")
        Set oRngTable = Sheets("Parameters").Range("R_TE_TABLE")
        strValue = oCell.Value
        Select Case strValue
          Case "Airfare Domestic - Coach"
            intMonth = oCell.Offset(0, -1).Value
            oCell.Offset(0, 1 + intMonth) = _
              af.Index(oRngTable, af.Match(strValue, oRng, 0), 3)
          Case Else
            ' What here?
        End Select
      Else
        MsgBox "Please Enter Travel Month"
      End If
    Next oCell
    ' Is this really necessary?
    Sheets("T&E Input").EnableCalculation = True
  End If
End Sub

[jstevens]

Hans,

It works great.

Thank you,
John