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?
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
I think this --

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

neeeds to be this --

Code: 
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
    Range("m21") = Application.InputBox("Enter DATE", "DSFR DATE", , , , , , 1)
ElseIf (Len(Desc) <> 0) And (Qty >= 7500) Then

Note ELSEif in lieu of if.
 
Upvote 0
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)
ElseIf (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

Jon, made the change and the new highlighted area has a error "Else without If" in the bold area???
 
Upvote 0
tried removing "ELSE" and left "IF"... no luck... anyone with a idea how to solve this?/Thanks
 
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") Then
                Range("m21") = Application.InputBox("Enter DATE", "DSFR DATE", , , , , , 1)
            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
        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 //
        Application.Undo
    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

Try on a backup...
 
Upvote 0
Works great!!! How can I change the input from date, to just a letter and number code? When I try to input a code likeCCF3605 it says invalid date? I was looking at the code, where did you make the change for it to work? Thanks for your help...
 
Upvote 0
one more question..

How can I have the "confirmation Code" not come up each time the user selects "Full Pull", after they already enter the code on the first "Full Pull" selection? Make sense?

Thanks for your time...
 
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
    Static BeenThereDoneThat As Boolean ' ADDED HERE
    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 Not BeenThereDoneThat Then ' ADDED HERE
                    BeenThereDoneThat = True ' ADDED HERE
                    Range("m21") = Application.InputBox("Enter DATE", "DSFR DATE", , , , , , 1)
                End If ' ADDED HERE
            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
        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 //
        Application.Undo
    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

See if this tests. Revision marked w/ ADDED HERE
 
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
396
Excel_Assis
E
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
376
sspatriots
S
N
  • Question
use Vba code in share workbook
Replies
6
Views
802
RoryA
RoryA
A
  • Question
Help Debugging Custom Data Label Macro
Replies
0
Views
133
arndtea
A
Y
  • Question
Help me find error in this coding
Replies
6
Views
369
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,985
Messages
6,122,602
Members
449,089
Latest member
Motoracer88

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