Code Help.

G

Giggzz

Well-known Member
Joined
Jul 4, 2002
Messages
990
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 = [D20]
MyPassword = "national" ' // ***** PUT YOUR PASSWORD HERE ***** //
Set DataRng = Worksheets(Location).[A1:Q67]
Set DescRng = Worksheets(Location).[B1:B67]
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:A34", "D25:D34")) 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 and B not a custom category. //
If (Range("B" & Target.Row) = "REMOVE & RELOCATE") Or (Range("B" & Target.Row) = "PURCHASE") Or (Range("B" & Target.Row) = "MISSING") Then
Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
If (Range("B" & Target.Row) = "FULL PULL") Then
Range("m21") = Application.InputBox("Enter DATE", "DSFR DATE", , , , , , 1) ElseIf (Len(Desc) <> 0) And (Qty >= 7500) 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)
End If
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), 16)
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 then recalc the Inst&Rental values //
Zone = [G20]: Location = [D20]
For i = 25 To 34
If (Range("A" & i) > 0) And (Len(Range("D" & i)) > 0) Then
Qty = Range("A" & i)
Desc = Range("D" & i)
If (Qty < 2500) Then
Range("G" & i) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 4))
End If
Range("I" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 16)
End If
Next i
ElseIf Not Intersect(Target, Range("G25:G34", "I25:I34")) 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. //
If (Target.Value = "REMOVE & RELOCATE") Or (Target.Value = "PURCHASE") Or (Target.Value = "MISSING") Then
Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
End If
Else
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 34
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

Trying to get the bold code to fire, but not having any luck. Anyone give any idea's?
 
Sort by date Sort by votes
Code: 
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 = [D20]
    MyPassword = "ABC" ' // ***** PUT YOUR PASSWORD HERE ***** //
    Set DataRng = Worksheets(Location).[A1:Q67]
    Set DescRng = Worksheets(Location).[B1:B67]
    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:A34", "D25:D34")) 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 and B not a custom category.      //
            If (Range("B" & Target.Row) = "REMOVE & RELOCATE") Or (Range("B" & Target.Row) = "PURCHASE") Or (Range("B" & Target.Row) = "MISSING") Then
                Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
            ElseIf (Range("B" & Target.Row) = "FULL PULL") Then
                 If Range("m21") = "" Then Range("m21") = UCase(Application.InputBox("Enter DSFR CODE", "DSFR CONFIRMATION", ""))
                 If (Range("B" & Target.Row) = "FULL PULL") Then Range("I" & Target.Row).ClearContents
                       ElseIf (Len(Desc) <> 0) And (Qty >= 2500) 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("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), 16)
        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
            ElseIf (Range("B" & Target.Row) = "FULL PULL") Then Range("I" & Target.Row).ClearContents
        End If
    ElseIf Not Intersect(Target, Range("D20", "G20")) Is Nothing Then
    ' // If Area or Zone changes then recalc the Inst&Rental values //
        Zone = [G20]: Location = [D20]
        For i = 25 To 34
            If (Range("A" & i) > 0) And (Len(Range("D" & i)) > 0) Then
                Qty = Range("A" & i)
                Desc = Range("D" & i)
                If (Qty < 2500) Then
                    Range("G" & i) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 4))
                End If
                Range("I" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 16)
            End If
        Next i
    ElseIf Not Intersect(Target, Range("G25:G34", "I25:I34")) 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. //
        If (Target.Value = "REMOVE & RELOCATE") Or (Target.Value = "PURCHASE") Or (Target.Value = "MISSING") Then
            Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
        End If
    Else
    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 34
        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

Hello Jon...  Im trying to clear the cells G & I when the user selects either "FULL PULL" or "PART PULL" for that row. But not having much luck getting it cleared, any idea? Thanks
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
BNot that it will settle this problem, but in regard to your prior problem did you try the last macro I posted?

I want to make sure I know what the current macro is.

Then all we need to do is clear G/I on the current row if FULL/PART PULL?
 
Upvote 0
Code: 
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 = [D20]
    MyPassword = "ABC" ' // ***** PUT YOUR PASSWORD HERE ***** //
    Set DataRng = Worksheets(Location).[A1:Q67]
    Set DescRng = Worksheets(Location).[B1:B67]
    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:A34", "D25:D34")) 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 and B not a custom category.      //
            If (Range("B" & Target.Row) = "REMOVE & RELOCATE") Or (Range("B" & Target.Row) = "PURCHASE") Or (Range("B" & Target.Row) = "MISSING") Then
                Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
            ElseIf (Range("B" & Target.Row) = "FULL PULL") Or (Range("B" & Target.Row) = "PART PULL") Then
                    Range("I" & Target.Row).ClearContents
                 If Range("m21") = "" Then Range("m21") = UCase(Application.InputBox("Enter DSFR CODE", "DSFR CONFIRMATION", ""))
                 
                       ElseIf (Len(Desc) <> 0) And (Qty >= 2500) 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("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), 16)
        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
            ElseIf (Range("B" & Target.Row) = "FULL PULL") Then Range("I" & Target.Row).ClearContents
        End If
    ElseIf Not Intersect(Target, Range("D20", "G20")) Is Nothing Then
    ' // If Area or Zone changes then recalc the Inst&Rental values //
        Zone = [G20]: Location = [D20]
        For i = 25 To 34
            If (Range("A" & i) > 0) And (Len(Range("D" & i)) > 0) Then
                Qty = Range("A" & i)
                Desc = Range("D" & i)
                If (Qty < 2500) Then
                    Range("G" & i) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), Application.WorksheetFunction.Match(Qty, QuanRng, 1) + ((Zone - 1) * 4))
                End If
                Range("I" & Target.Row) = Application.WorksheetFunction.Index(DataRng, Application.WorksheetFunction.Match(Desc, DescRng, 0), 16)
            End If
        Next i
    ElseIf Not Intersect(Target, Range("G25:G34", "I25:I34")) 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. //
        If (Target.Value = "REMOVE & RELOCATE") Or (Target.Value = "PURCHASE") Or (Target.Value = "MISSING") Then
            Range("G" & Target.Row) = Application.InputBox("Enter rate", "Purchase/Remove & Relocate Custom Rate", , , , , , 1)
        End If
    Else
    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 34
        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



This is the current code.....  Yes just trying to clear G & I when FULL PULL or PART PULL has been selected. Thanks for your time and help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
VB Help with code to copy selected rows to specified cells in another sheet.
2
Replies
12
Views
419
Excel_Assis
E
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
410
sspatriots
S
N
  • Question
use Vba code in share workbook
Replies
6
Views
816
RoryA
RoryA
A
  • Question
Help Debugging Custom Data Label Macro
Replies
0
Views
177
arndtea
A
Y
  • Question
Help me find error in this coding
Replies
6
Views
379
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,516
Messages
6,125,285
Members
449,218
Latest member
Excel Master

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