Additional code needed for existing working code

ipbr21054

Well-known Member
Evening,
I am using the working code supplied below.

So this code works like so.
If i enter in a cell in column D the number 3 once i leave that cell it changes to the word HUTTON STORES & also then in the next cell to the right of it the number 6, this is fine BUT if i forget to enter the number 3 & start to type HUTTON STORES it then completes itself as ive done it a few times above etc but i need to then manually enter the number 6 in the cell to the right.

Understand me on this ?

Basically i need the digit to also automatically get entered in the column E cell even if i manually type the name in the column D cell.


Maybe something along the lines of If cell D = HUTTON STORES then cell E = 6 etc etc & same code for the other options
Thanks


Code:
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) = 1
    If Target.Value = "2" Then Target.Value = "CHURCHILL POST OFFICE": Target.Offset(, 1) = 7
    If Target.Value = "3" Then Target.Value = "HUTTON STORES":         Target.Offset(, 1) = 6
    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) = 5
    If Target.Value = "6" Then Target.Value = "H-VILLAGE CO-OP":       Target.Offset(, 1) = 7
    If Target.Value = "7" Then Target.Value = "LIDL":                  Target.Offset(, 1) = 7
    If Target.Value = "8" Then Target.Value = "MORRISSONS":            Target.Offset(, 1) = 6
    If Target.Value = "9" Then Target.Value = "EBAY":                  Target.Offset(, 1) = 0
    
    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
 
Last edited:

ipbr21054

Well-known Member
Hi,
I don’t think that’s correct for me.

The code should be something like my poor example below.
Take range from code supplied above.
So if cell in column D = HUTTON STORES then cell to the right = 6

If cell in column D = EBAY then cell to the right = 0
 

DanteAmor

Well-known Member
Try this

Code:
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" Or Target.Value = "BANWELL NEWS" Then Target.Value = "BANWELL NEWS":                    Target.Offset(, 1) = 1
    If Target.Value = "2" Or Target.Value = "CHURCHILL POST OFFICE" Then Target.Value = "CHURCHILL POST OFFICE":  Target.Offset(, 1) = 7
    If Target.Value = "3" Or Target.Value = "HUTTON STORES" Then Target.Value = "HUTTON STORES":                  Target.Offset(, 1) = 6
    If Target.Value = "4" Or Target.Value = "OLD MIXON MCCOLLS" Then Target.Value = "OLD MIXON MCCOLLS":          Target.Offset(, 1) = 8
    If Target.Value = "5" Or Target.Value = "THE CAXTON LIBRARY" Then Target.Value = "THE CAXTON LIBRARY":        Target.Offset(, 1) = 5
    If Target.Value = "6" Or Target.Value = "H-VILLAGE CO-OP" Then Target.Value = "H-VILLAGE CO-OP":              Target.Offset(, 1) = 7
    If Target.Value = "7" Or Target.Value = "LIDL" Then Target.Value = "LIDL":                                    Target.Offset(, 1) = 7
    If Target.Value = "8" Or Target.Value = "MORRISSONS" Then Target.Value = "MORRISSONS":                        Target.Offset(, 1) = 6
    If Target.Value = "9" Or Target.Value = "EBAY" Then Target.Value = "EBAY":                                    Target.Offset(, 1) = 0
    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
 

Some videos you may like

This Week's Hot Topics

Top