Expand on current code in use

[ipbr21054]

Hi,

Supplied is the current code in use.
I wish to expand the code to apply a number in the corresponding cell in column E
Target cells are currently in column D "name of shop" & now wish to also add in column E "mileage to that shop"

Currently if i enter 1 in the target cell i then see BANWELL NEWS appear, It is at this point i wish to also have 3 appear in the next cell to the right in column E, So my new databse for this would be like,

BANWELL NEWS 3
CHURCHILL POST OFFICE 6
HUTTON STORES 7
OLD MIXON MCCOLLS 8
THE CAXTON LIBRARY 2
HAYWOOD VILLAGE CO-OP 5

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("D5:D30")) Is Nothing Then


        If UCase(Target.Value) = "1" Then Target.Value = "BANWELL NEWS"
        If UCase(Target.Value) = "2" Then Target.Value = "CHURCHILL POST OFFICE"
        If UCase(Target.Value) = "3" Then Target.Value = "HUTTON STORES"
        If UCase(Target.Value) = "4" Then Target.Value = "OLD MIXON MCCOLLS"
        If UCase(Target.Value) = "5" Then Target.Value = "THE CAXTON LIBRARY"
        If UCase(Target.Value) = "6" Then Target.Value = "HAYWOOD VILLAGE CO-OP"


End If
    If Not (Application.Intersect(Target, Range("A2:D30")) _
      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

Have a nice day

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)


  If Target.Count > 1 Then Exit Sub
  On Error GoTo Eventes_Activate
  If Not Intersect(Target, Range("D5:D30")) Is Nothing Then
    Application.EnableEvents = False
  
    If Target.Value = "1" Then Target.Value = "BANWELL NEWS":          Target.Offset(, 1) = 3
    If Target.Value = "2" Then Target.Value = "CHURCHILL POST OFFICE": Target.Offset(, 1) = 6
    If Target.Value = "3" Then Target.Value = "HUTTON STORES":         Target.Offset(, 1) = 7
    If Target.Value = "4" Then Target.Value = "OLD MIXON MCCOLLS":     Target.Offset(, 1) = 8
    If Target.Value = "5" Then Target.Value = "THE CAXTON LIBRARY":    Target.Offset(, 1) = 2
    If Target.Value = "6" Then Target.Value = "HAYWOOD VILLAGE CO-OP": Target.Offset(, 1) = 5
    
    Application.EnableEvents = False


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


Eventes_Activate:
  Application.EnableEvents = True
End Sub

 

[dmt32]

Hi,
see if this does what you want

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Count > 1 Then Exit Sub
    On Error GoTo myerror
    
    If Not Intersect(Target, Range("D5:D30")) Is Nothing Then
        
        Application.EnableEvents = False
        
        Target.Value = Choose(Target.Value, "BANWELL NEWS", "CHURCHILL POST OFFICE", "HUTTON STORES", _
                                            "HUTTON STORES", "THE CAXTON LIBRARY", "HAYWOOD VILLAGE CO-OP")
        Target.Offset(, 1).Value = Choose(Target.Value, 3, 6, 7, 8, 2, 5)
        
    End If
    
    If Not Intersect(Target, Range("A2:D30")) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If Not .HasFormula Then
                
                .Value = UCase(.Value)
            End If
        End With
    End If
    
myerror:
    Application.EnableEvents = True
End Sub

Solution avoids need for all your If Statements

Dave

 

[ipbr21054]

Works a treat thanks @DanteAmor

 

[DanteAmor]

Works a treat thanks @DanteAmor

I'm glad to help you. Thanks for the feedback.