Could you check & advise on my code please

[ipbr21054]

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

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.

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

 

[ipbr21054]

Thanks.

Is this a typo ?
.NumberFormat = "£0.00"

 

[ipbr21054]

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

Dave.

Thanks but deleting that line made no difference.

But what JoeMo advised im using but still i get that message block if without end if

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

Thanks very much for all the helped me today

 

[JoeMo]

But what JoeMo advised im using but still i get that message block if without end if

Have you tried copying the code I posted directly from your browser and pasting it (overwrite) to the VBE window?

 

[ipbr21054]

Hi,
Sorry but that was my mistake.

The help that i asked for has now be complted many thanks.

A error has popped up but i will start a new post.