Excel VBA Worksheet_Change

[MaxMiller]

I am trying to automatically change values by a percentage when they are entered based on criteria contained in a previous row.

I have tried to do this using the following code:

Public Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("I14:I44")) Is Nothing Then
With Target
If IsNumeric(.Value) Then
.Value = .Value * 1.08
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Problem is I want to calculate a different percentage based on the values of "E14:E44" which are bound by the following list: "LTL", "Truckload", "Tank Truck" & "IM". I think some sort of Vlookup would be ideal but not sure if that can be incorporated into Worksheet_change.

Any help is greatly appreciated!

 

[Tom Urtis]

Whataver you tried to post image-wise did not display, so maybe if you explain a bit farther about what "bound by the following list: "LTL", "Truckload", "Tank Truck" & "IM"" means in terms of its relevance to "the values of "E14:E44"" which is 31 cells, many more than that first 4-item list. Having a hard time grasping what you are working with.

 

[MaxMiller]

Sorry for the cofusion... the cell reference has list data validation. If the user has chosen "LTL" in E14 and then enters a number value in I14, I want the number to be automatically multiplied by 1.08. If the user has entered TL, the number should be multiplied by a different percentage (1.1) or whatever.

 

[MaxMiller]

I was thinking maybe an if function in the VBA script looking for a certain value in cells "E14:E44" but could not get anything to work.

 

[Tom Urtis]

If the percentages don't change often then they can be hard coded, otherwise a lookup table somewhere convenient can be assembled where you can change the percentages. Which is the situation...the percentages and "LTL" items change often, or not often.

And, just to be clear, is it that what is in cell E20 is what should be looked at when a number is entered into I20? is that what is going on?

 

[MaxMiller]

Correct. I want the percentage to be added to the numeric values in I14:I44 based on the Value in E14:E44. To use your example, if E20 = "LTL" then automatically multiply any value entered in I20 by 1.08. If E20 = "TL" then automatically multiply any value entered in I20 by 1.1.

 

[MaxMiller]

The percentages are directly correlated to the text. LTL = 1.08 ; TL = 1.1 ; Tank Truck = 1.09 ; IM = 1.12

 

[Tom Urtis]

Delete the current SheetChange code you were using, and try this instead:

Public Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I14:I44")) Is Nothing _
Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) = True Then Exit Sub
With Target
If IsNumeric(.Value) Then
Dim pctVal As Double
Select Case Cells(.Row, .Column - 4).Value
Case "LTL": pctVal = 1.08
Case "TL": pctVal = 1.1
Case "Tank Truck": pctVal = 1.09
Case "IM": pctVal = 1.12
Case Else: pctVal = 1
End Select
Application.EnableEvents = False
.Value = .Value * pctVal
Application.EnableEvents = True
End If
End With
End Sub

 

[MaxMiller]

Wow... thanks a bunch Tom!

 

[MaxMiller]

So... If I want to do the same thing to rows J,K,&L; how would I duplicate the code... I copied the if and pasted but excel is giving me the error "Dim pctVal As Double".

the code looks like this...

Public Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("I14:I44")) Is Nothing _
Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) = True Then Exit Sub
With Target
If IsNumeric(.Value) Then
Dim pctVal As Double
Select Case Cells(.Row, .Column - 4).Value
Case "LTL": pctVal = 1.08
Case "TL": pctVal = 1.1
Case "Tank Truck": pctVal = 1.09
Case "IM": pctVal = 1.12
Case Else: pctVal = 1
End Select
Application.EnableEvents = False
.Value = .Value * pctVal
Application.EnableEvents = True
End If
End With

If Intersect(Target, Range("J14:J44")) Is Nothing _
Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) = True Then Exit Sub
With Target
If IsNumeric(.Value) Then
Dim pctVal As Double
Select Case Cells(.Row, .Column - 5).Value
Case "LTL": pctVal = 1.08
Case "TL": pctVal = 1.1
Case "Tank Truck": pctVal = 1.09
Case "IM": pctVal = 1.12
Case Else: pctVal = 1
End Select
Application.EnableEvents = False
.Value = .Value * pctVal
Application.EnableEvents = True
End If
End With