Could you check & advise on my code please

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,237
Office Version
  1. 2007
Platform
  1. Windows
Afternoon,
I have the code below but stuck with the red section.

I have a drop down list in cell G36
The 3 options are,
INTERNATIONAL SIGNED FOR
UK SIGNED FOR
UK SPECIAL DELIVERY

Upon the selection i would like the following to happen please.

INTERNATIONAL SIGNED FOR in cell J36 enter 1 and in cell L36 £12.00
UK SIGNED FOR in cell J36 enter 1 and in cell L36 £4.00
UK SPECIAL DELIVERY in cell J36 enter 1 and in cell L36 £10.00



Code: 
Private Sub Worksheet_Change(ByVal Target As Range)



If Not Intersect(Target, Range("G36")) Is Nothing Then




[COLOR=#ff0000]If UCase(Target.Value) = "INTERNATIONAL SIGNED FOR" Then Range.Value("J36") = "1",Range.Value("L36") = "£12.00"[/COLOR]
[COLOR=#ff0000]If UCase(Target.Value) = "UK SIGNED FOR" Then Range.Value("J36") = "1",Range.Value("L36") = "£4.00"[/COLOR]
[COLOR=#ff0000]If UCase(Target.Value) = "UK SPECIAL DELIVERY" Then Range.Value("J36") = "1",Range.Value("L36") = "£10.00"[/COLOR]




End If
    If Not (Application.Intersect(Target, Range("G27:O36")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If


End Sub

On the same page i already have a Private Sub Worksheet_Change(ByVal Target As Range) shown below so the two would need to be merged please.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Dim C As Range, d As Range
Set d = Intersect(Target, Range("G13:O17", "G27:O42"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each C In d
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next
        If Intersect(Target, Range("G13")) Is Nothing Then Exit Sub
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
I don't have time right now to look at the whole thing but one thing jumping out at me in the red bit is that I've never seen Range.Value written that way (with the brackets after the word Value) - not sure it works like that?

Should it not be Range("A1").Value =
?

Try changing all those and see if it works.
 
Upvote 0
Had a bit more time than I thought. For me putting a comma then another Range.Value doesn't work, I have to do it on the next line.

Try (for the red bit):
Code: 
If UCase(Target.Value) = "INTERNATIONAL SIGNED FOR" Then
  Range("J36").Value = 1
  Range("L36").Value = "£12.00"
End If

If UCase(Target.Value) = "UK SIGNED FOR" Then
   Range("J36").Value = 1
   Range("L36").Value = "£4.00"
End If

If UCase(Target.Value) = "UK SPECIAL DELIVERY" Then
   Range("J36").Value = 1
   Range("L36").Value = "£10.00"
End If

I am not sure about the UCase thing, never used it before. If it's not essential to the code, and the above doesn't work, try removing the Ucase() from each of the three IF statements.
 
Last edited:
Upvote 0
Hi,
Im now trying to merge the two worksheet_change so i can see if it works.
Im at this point but need some help please.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Dim C As Range, d As Range
Set d = Intersect(Target, Range("G13:O17", "G27:O42"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each C In d
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next
        If Intersect(Target, Range("G13")) Is Nothing Then Exit Sub
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If
        Then
        If Not Intersect(Target, Range("G36")) Is Nothing Then


If (Target.Value) = "INTERNATIONAL SIGNED FOR" Then
  Range("J36").Value = 1
  Range("L36").Value = "£12.00"
End If


If (Target.Value) = "UK SIGNED FOR" Then
   Range("J36").Value = 1
   Range("L36").Value = "£4.00"
End If


If (Target.Value) = "UK SPECIAL DELIVERY" Then
   Range("J36").Value = 1
   Range("L36").Value = "£10.00"
End If




End Sub
 
Upvote 0
Sorry I didn't write the last bit of my post very clearly. If you are removing UCase, you can (and should) also remove the brackets around "Target.Value". But I now understand why you were using UCase and I think it's fine to put it back in.

So either keep the brackets and put UCase back infront of them:
Code: 
If UCase(Target.Value) = ...

Or remove both:
Code: 
If Target.Value = ...

Sorry I really do have to go now so can't look in to the merging thing, but hope this has helped in some way.
 
Upvote 0
Ok,
I have merged them now.
i have tried it out but the 1 and the £ value do not get entered into the cells.
Also i dont get any kind of error message..
I have this code.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Dim C As Range, d As Range
Set d = Intersect(Target, Range("G13:O17", "G27:O42"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each C In d
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next
        If Intersect(Target, Range("G13")) Is Nothing Then Exit Sub
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If
        
        If Not Intersect(Target, Range("G36")) Is Nothing Then


If Target.Value = "INTERNATIONAL SIGNED FOR" Then
  Range("J36").Value = 1
  Range("L36").Value = "£12.00"
End If


If Target.Value = "UK SIGNED FOR" Then
   Range("J36").Value = 1
   Range("L36").Value = "£4.00"
End If


If Target.Value = "UK SPECIAL DELIVERY" Then
   Range("J36").Value = 1
   Range("L36").Value = "£10.00"
End If
End If


End Sub
 
Upvote 0
ipbr21054 said:
Ok,

i have tried it out but the 1 and the £ value do not get entered into the cells.
Also i dont get any kind of error message..
I have this code.
Click to expand...

If you want to display the value of your cell as currency then you would enter a numeric value & format the cell accordingly

try, this update & see if it will do what you want

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim m As Variant
    On Error GoTo exitsub
    If Not Intersect(Target, Range("G36")) Is Nothing Then
    
        m = Application.Match(Target.Value, Array("INTERNATIONAL SIGNED FOR", _
                                                   "UK SIGNED FOR", _
                                                   "UK SPECIAL DELIVERY"), 0)
        If Not IsError(m) Then
            Application.EnableEvents = False
            Me.Range("J36").Value = 1
            With Me.Range("L36")
                .Value = Choose(m, 12, 4, 10)
                .NumberFormat = "£0.00"
            End With
        End If
    End If
exitsub:
    Application.EnableEvents = True
End Sub

Apologies but I do not have time to work through rest of your code.

Dave.
 
Upvote 0
Hi,
If i use your code only like shown below it works spot on.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)    Dim m As Variant
    On Error GoTo exitsub
    If Not Intersect(Target, Range("G36")) Is Nothing Then
    
        m = Application.Match(Target.Value, Array("INTERNATIONAL SIGNED FOR", _
                                                   "UK SIGNED FOR", _
                                                   "UK SPECIAL DELIVERY"), 0)
        If Not IsError(m) Then
            Application.EnableEvents = False
            Me.Range("J36").Value = 1
            With Me.Range("L36")
                .Value = Choose(m, 12, 4, 10)
                .NumberFormat = "£0.00"
            End With
        End If
    End If
exitsub:
    Application.EnableEvents = True
End Sub

However if i use it with my merged code so its now like below i get the error message Block If Without End If

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Dim C As Range, d As Range
Set d = Intersect(Target, Range("G13:O17", "G27:O42"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each C In d
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next
        If Intersect(Target, Range("G13")) Is Nothing Then Exit Sub
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If
        
        If Not Intersect(Target, Range("G36")) Is Nothing Then




    Dim m As Variant
    On Error GoTo exitsub
    If Not Intersect(Target, Range("G36")) Is Nothing Then
    
        m = Application.Match(Target.Value, Array("INTERNATIONAL SIGNED FOR", _
                                                   "UK SIGNED FOR", _
                                                   "UK SPECIAL DELIVERY"), 0)
        If Not IsError(m) Then
            Application.EnableEvents = False
            Me.Range("J36").Value = 1
            With Me.Range("L36")
                .Value = Choose(m, 12, 4, 10)
                .NumberFormat = "£0.00"
            End With
        End If
    End If
exitsub:
    Application.EnableEvents = True
End Sub
 
Upvote 0
ipbr21054 said:
Ok,
I have merged them now.
i have tried it out but the 1 and the £ value do not get entered into the cells.
Also i dont get any kind of error message..
Click to expand...
I haven't tested this so it may need some tweaking. I changed the first intersection range to Range("G13:O17, G27:O42")), and I am using the bit that dmt32 posted for the second event, as well. Your code has to be modified so that in the event there is no intersect for the first event you don't exit the sub, but rather move on to see if the second event has occurred.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, d As Range
If Not Intersect(Target, Range("G13:O17, G27:O42")) Is Nothing Then
Application.EnableEvents = False
    For Each C In Intersect(Target, Range("G13:O17, G27:O42"))
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next C
    If Intersect(Target, Range("G13")) Is Nothing Then GoTo NxEvent
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If
End If
                
NxEvent: If Not Intersect(Target, Range("G36")) Is Nothing Then
m = Application.Match(Target.Value, Array("INTERNATIONAL SIGNED FOR", _
                                                   "UK SIGNED FOR", _
                                                   "UK SPECIAL DELIVERY"), 0)
        If Not IsError(m) Then
            Application.EnableEvents = False
            Me.Range("J36").Value = 1
            With Me.Range("L36")
                .Value = Choose(m, 12, 4, 10)
                .NumberFormat = "£0.00"
            End With
        End If
    End If
exitsub:
Application.EnableEvents = True
End Sub
 
Upvote 0
ipbr21054 said:
Hi,
If i use your code only like shown below it works spot on.



However if i use it with my merged code so its now like below i get the error message Block If Without End If

Code: 
[COLOR=#d3d3d3]Private Sub Worksheet_Change(ByVal Target As Range)Dim C As Range, d As Range
Set d = Intersect(Target, Range("G13:O17", "G27:O42"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each C In d
        If C.Column <> 14 Then
            If Not C.HasFormula Then C = UCase(C)
        End If
    Next
        If Intersect(Target, Range("G13")) Is Nothing Then Exit Sub
    Dim rName As Range, srcWS As Worksheet
    Set srcWS = Sheets("DATABASE")
    Set rName = srcWS.Range("A6:A" & srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not rName Is Nothing Then
        Range("N15") = srcWS.Range("B" & rName.Row)
        Range("N14") = srcWS.Range("D" & rName.Row)
        Range("N16") = srcWS.Range("L" & rName.Row)
        Range("N17") = srcWS.Range("W" & rName.Row)
        Range("G14") = srcWS.Range("R" & rName.Row)
        Range("G15") = srcWS.Range("S" & rName.Row)
        Range("G16") = srcWS.Range("T" & rName.Row)
        Range("G17") = srcWS.Range("U" & rName.Row)
        Range("G18") = srcWS.Range("V" & rName.Row)
        Application.EnableEvents = True
        End If[/COLOR]
        
        [COLOR=#ff0000]If Not Intersect(Target, Range("G36")) Is Nothing Then[/COLOR]




   [COLOR=#d3d3d3] Dim m As Variant
    On Error GoTo exitsub
    If Not Intersect(Target, Range("G36")) Is Nothing Then
    
        m = Application.Match(Target.Value, Array("INTERNATIONAL SIGNED FOR", _
                                                   "UK SIGNED FOR", _
                                                   "UK SPECIAL DELIVERY"), 0)
        If Not IsError(m) Then
            Application.EnableEvents = False
            Me.Range("J36").Value = 1
            With Me.Range("L36")
                .Value = Choose(m, 12, 4, 10)
                .NumberFormat = "£0.00"
            End With
        End If
    End If
exitsub:
    Application.EnableEvents = True
End Sub[/COLOR]
Click to expand...


You have extra line of code shown in red - delete it & see if this solves your issue

Dave.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
vba Code shows wrong format in cell & autosum also ignors the value
Replies
3
Views
283
RobP
R
A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
205
Ark68
A
S
  • Question
Including Date Worked in Range D:D when Value in R:R Changes
Replies
0
Views
306
Sharonca
S
K
  • Solved
VBA code to change text entered in cell to uppercase
Replies
6
Views
563
KMH
K
J
  • Solved
Running code in Range EXCEPT if specific values are found in cell.
Replies
4
Views
535
jmpatrick
J

Forum statistics

Threads
1,215,694
Messages
6,126,252
Members
449,305
Latest member
Dalyb2

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