VBA code help

G

Giggzz

Well-known Member
Joined
Jul 4, 2002
Messages
990
This code works perfect I want to expand on my ZONES, right now there is 5 and I want to expand to 6. The error I get is " unable to get index property of the worksheetfunction class". Im just not sure what area I need to look at to adjust the code to see the additional zone. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
' STILL NEED PROTECTION ROUTINE FOR J-M
Dim DataRng As Range, DescRng As Range, QuanRng As Range
Dim Desc As String, Location As String, MyPassword As String
Dim Qty As Long, Zone As Long
Static BigQtyPwd As String
Location = [D21]
MyPassword = "ABC" ' // ***** PUT YOUR PASSWORD HERE ***** //
Set DataRng = Worksheets(Location).[A1:AD93]
Set DescRng = Worksheets(Location).[B1:B93]
Set QuanRng = Worksheets(Location).[A2:i2]
On Error GoTo Xit
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
' // If the changed cell is not in the range of A25:D40 then go down //
' // to the next check and see if it is cell D20 or cell G21. //
If Not Intersect(Target, Range("A26:A35", "D26:D35")) Is Nothing Then
' // Seed Install & Rental rates if there is a quantity and a description. //
If (Range("A" & Target.Row) > 0) And (Len(Range("D" & Target.Row)) > 0) Then
Qty = Range("A" & Target.Row)
Desc = Range("D" & Target.Row)
Zone = [G21]
' // Get password, & price, if quantity is greater than 2499 and B not a custom category. //
' // <<<<<THIS below with work to trying I?m area the is>>>>>
If Range("B" & Target.Row) = "DAMAGED" Or Range("B" & Target.Row) = "MISSING" Then
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 39)


ElseIf Range("B" & Target.Row) = "PURCHASE" Then
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 40)

ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Right(Range("D" & Target.Row), 10) = "SWING GATE" Then
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 9)) - 25
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Right(Range("D" & Target.Row), 26) = "CHAIN LINK & POUNDED POSTS" Then
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 9)) - 0.1
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Right(Range("D" & Target.Row), 26) = "6' PANELS WITH STANDS" Then
Range("H" & Target.Row) = 1.95
ElseIf (Range("B" & Target.Row) = "REINSTALL") And Right(Range("D" & Target.Row), 26) = "6' PANELS WITH STANDS" Then
Range("H" & Target.Row) = 1.95
ElseIf (Range("B" & Target.Row) = "REINSTALL") And Right(Range("D" & Target.Row), 29) = "6' CHAIN LINK & POUNDED POSTS" Then
Range("H" & Target.Row) = 2.25
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Right(Range("D" & Target.Row), 26) = "8' PANELS WITH STANDS" Then
Range("H" & Target.Row) = 2.75
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Left(Range("D" & Target.Row), 13) = "6' WINDSCREEN" Then
Range("H" & Target.Row) = 1.75
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Left(Range("D" & Target.Row), 13) = "8' WINDSCREEN" Then
Range("H" & Target.Row) = 2.75
ElseIf (Range("B" & Target.Row) = "REMOVE & RELOCATE") And Left(Range("D" & Target.Row), 9) = "SAND BAGS" Then
Range("H" & Target.Row) = 3
ElseIf (Range("B" & Target.Row) = "GENERAL REPAIR" Or Range("B" & Target.Row) = "RETIE") And Left(Range("D" & Target.Row), 29) = "6' CHAIN LINK & POUNDED POSTS" Then
Range("H" & Target.Row) = 1.65
ElseIf (Range("B" & Target.Row) = "GENERAL REPAIR" Or Range("B" & Target.Row) = "RETIE") And Left(Range("D" & Target.Row), 29) = "8' CHAIN LINK & POUNDED POSTS" Then
Range("H" & Target.Row) = 1.95
ElseIf (Range("B" & Target.Row) = "DAMAGED - REMOVE & REPLACE") Then
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 9)) + Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 39)

ElseIf (Range("B" & Target.Row) = "FULL PULL") Or (Range("B" & Target.Row) = "PART PULL") Then
Range("H" & Target.Row).ClearContents
ElseIf (Len(Desc) <> 0) And (Qty >= 20000) Then
If (UserForm1.TextBox1.Text <> MyPassword) And (PasswordIsVerified = False) Then
UserForm1.Show
If (UserForm1.TextBox1.Text = MyPassword) Then
PasswordIsVerified = True
Range("G" & Target.Row) = Application.InputBox("Enter rate", "Large Quantity Custom Rate", , , , , , 1)
Else
MsgBox "Sorry, that was incorrect. Exiting."
Range("A" & Target.Row) = vbNullString
Range("H" & Target.Row) = vbNullString

GoTo Xit
End If
Else
Range("H" & Target.Row) = Application.InputBox("Enter rate", "Large Quantity Custom Rate", , , , , , 1)
End If
Else
Range("H" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 9))
End If
' Seed the Rantal rate here. //

ElseIf (UserForm1.TextBox1.Text <> MyPassword) Then
' // If either the quantity or description //
' // is null set G and I to null as well. //
Range("H" & Target.Row) = vbNullString

ElseIf (Range("B" & Target.Row) = "FULL PULL") Or (Range("B" & Target.Row) = "DAMAGED") Or (Range("B" & Target.Row) = "BRING EXTRA") Then Range("H" & Target.Row).ClearContents



End If
ElseIf Not Intersect(Target, Range("D21", "G21")) Is Nothing Then
' // If Area or Zone changes then recalc the Inst&Rental values //
Zone = [G21]: Location = [D21]
For i = 38 To 39
If (Range("A" & i) > 0) And (Len(Range("D" & i)) > 0) Then
Qty = Range("A" & i)
Desc = Range("D" & i)
If (Qty < 20000) Then
Range("H" & i) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 9))
End If

End If
Next i
ElseIf Not Intersect(Target, Range("G26:G35", "I26:I35")) Is Nothing Then
' // If any attempt is made to directly change the Inst+Rmvl or Rental rates //

ElseIf Not Intersect(Target, Range("B25:B34")) Is Nothing Then
' // Custom pricing in these cases. //

End If
Xit:
' Cleanup here. //
If Err.Number <> 0 Then
ErrMsg = "Error:" & str(Err.Number) & " was generated " _
& Err.Source & Chr(13) & Err.Description
MsgBox ErrMsg, , "Error", Err.HelpFile, Err.HelpContext
MsgBox "Processing Terminated."
Err.Clear
End If
For i = 25 To 27
If (Len(Range("A" & i)) = 0) Or (Len(Range("D" & i)) = 0) Then
Range("H" & i) = vbNullString

End If
Next i
' // Zap variables. //
Set DataRng = Nothing
Set DescRng = Nothing
Set HeadRng = Nothing
Application.Calculation = xlCalculationAutomatic


If Not Intersect(ActiveCell, [A26:I35]) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect ("as")
Range("K7").Formula = "=NOW()"
ActiveSheet.Protect ("as")

End If
ActiveSheet.Protect ("as")
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Even I want to see what the answer to this is! I can't really determine what the ZONEs are for one thing, but from what I did see it LOOKS like the Target parameter might point to the ZONE?? If so, just reference it in the other code as such...
 
Upvote 0
[face=Courier New]Private Sub Worksheet_Change(ByVal Target As Range)
Dim DataRng As Range, DescRng As Range, QuanRng As Range
Dim Desc As String, Location As String, MyPassword As String
Dim Qty As Long, Zone As Long
Static BigQtyPwd As String
Location = [D20]
MyPassword = "ABC" ' // ***** PUT YOUR PASSWORD HERE ***** //
Set DataRng = Worksheets(Location).[A1:Q60]
Set DescRng = Worksheets(Location).[B1:B60]
Set QuanRng = Worksheets(Location).[A2:G2]
On Error GoTo Xit
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
' // If the changed cell is not in the range of A25:D40 then go down //
' // to the next check and see if it is cell D20 or cell G20. //
If Not Intersect(Target, Range("A25:A40", "D25:D40")) Is Nothing Then
' // Seed Install & Rental rates if there is a quantity and a description. //
If (Range("A" & Target.Row) > 0) And (Len(Range("D" & Target.Row)) > 0) Then
Qty = Range("A" & Target.Row)
Desc = Range("D" & Target.Row)
Zone = [G20]
' // Get password, & price, if quantity is //
' // greater than 2499. //
If (Target.Column = 1) And (Target.Value >= 2500) Then
If (UserForm1.TextBox1.Text <> MyPassword) Then
UserForm1.Show
If (UserForm1.TextBox1.Text = MyPassword) Then
Range("G" & Target.Row) = Application.InputBox("Enter rate", "Large Quantity Custom Rate", , , , , , 1)
Else
MsgBox "Sorry, that was incorrect. Exiting."
Range("A" & Target.Row) = vbNullString
Range("G" & Target.Row) = vbNullString
Range("I" & Target.Row) = vbNullString
GoTo Xit
End If
Else
Range("G" & Target.Row) = Application.InputBox("Enter rate", "Large Quantity Custom Rate", , , , , , 1)
End If
Else
Range("G" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 4))
End If
' Seed the Rantal rate here. //
Range("I" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 28)
ElseIf (UserForm1.TextBox1.Text <> MyPassword) Then
' // If either the quantity or description //
' // is null set G and I to null as well. //
Range("G" & Target.Row) = vbNullString
Range("I" & Target.Row) = vbNullString
End If
ElseIf Not Intersect(Target, Range("D20", "G20")) Is Nothing Then
' // If Area or Zone changes //
' // recalc the Inst&Rental //
Zone = [G20]: Location = [D20]
For i = 25 To 28
If (Range("A" & i) > 0) And (Len(Range("D" & i)) > 0) Then
Qty = Range("A" & i)
Desc = Range("D" & i)
Range("G" & i) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 4))
Range("I" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 28)
End If
Next i
ElseIf Not Intersect(Target, Range("G25:G40", "I25:I40")) Is Nothing Then
' // If any attempt is made to directly change the Inst+Rmvl or Rental rates //
Application.Undo
Else
End If
Xit:
' Cleanup here. //
For i = 25 To 28
If (Len(Range("A" & i)) = 0) Or (Len(Range("D" & i)) = 0) Then
Range("G" & i) = vbNullString
Range("I" & i) = vbNullString
End If
Next i
' // Zap variables. //
Set DataRng = Nothing
Set DescRng = Nothing
Set HeadRng = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
[/face]

Reposted the code

Still having the issue locating part of the code that I can expand the zones. I have seen ((Zone - 1) * 4)) and changed the 4 to a 5 and 6 but still not able to see the extra Zones(5 and 6) I added. :confused:
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
2 codes same page
Replies
3
Views
292
Michael M
Michael M
C
  • Solved
"Ambiguous name detected: Worksheet_Change" when adding 2 change events codes on the same sheet
2
Replies
10
Views
1K
Peter_SSs
Peter_SSs
C
  • Question
VBA to delete text after multiple carriage return (line break)
Replies
1
Views
1K
Chipperzs
C
C
  • Question
PLEASE HELP VBA - SO LONG NEEDS CONDENSING AND OPTIMIZATION
Replies
4
Views
251
davesexcel
davesexcel
P
  • Question
VBA Email When a percentage hits 100.
Replies
4
Views
454
portews
P

Forum statistics

Threads
1,215,876
Messages
6,127,482
Members
449,385
Latest member
KMGLarson

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top