Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Abbrev
Dim changed As Range, c As Range
Dim m As Variant
Const AbbrevCol As String = "B"
Set changed = Intersect(Target, Columns(AbbrevCol))
If Not changed Is Nothing Then
Abbrev = Array("g", "grams", "ts", "teaspoons", "tb", "tablespoons", "c", "cups", "m", "mls")
Application.EnableEvents = False
For Each c In changed
m = Application.Match(c.Value, Abbrev, False)
If IsNumeric(m) Then
If m Mod 2 = 1 Then
c.Value = Abbrev(m + 1)
End If
End If
Next c
Application.EnableEvents = True
End If
End SubVery nice approach.Welcome to the MrExcel board!
I'm assuming that you want the longer words to actually replace what you type in column B.
(If you didn't need that and would be happy with the full words appearing in, say, column C then you could use a VLOOKUP formula in column C)
A. You could (I'm not recommending this) add AutoCorrect entries to change "c" to "cups" etc. This is simple enough to do BUT would mean "c" changing to "cups" in any column in any spreadsheet or any other Office program until you remembered to go back in and delete those AutoCorrect entries. Way too risky in my mind!
B. Better option, but does require macros to be enabled and your file saved as a macro-enabled file (.xlsm) if using Excel 2007 or later.
This option assumes that column B only gets the g, c etc. That is if you want 3 cups, you would put the "3" in column A and the "c" in column B
To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window and test.
Code:Option Explicit Option Base 1 Private Sub Worksheet_Change(ByVal Target As Range) Dim Abbrev Dim changed As Range, c As Range Dim m As Variant Const AbbrevCol As String = "B" Set changed = Intersect(Target, Columns(AbbrevCol)) If Not changed Is Nothing Then Abbrev = Array("g", "grams", "ts", "teaspoons", "tb", "tablespoons", "c", "cups", "m", "mls") Application.EnableEvents = False For Each c In changed m = Application.Match(c.Value, Abbrev, False) If IsNumeric(m) Then If m Mod 2 = 1 Then c.Value = Abbrev(m + 1) End If End If Next c Application.EnableEvents = True End If End Sub
If I haven't guessed well enough what you want, post back with more details.
Function rd(ByVal sInp As String) As String
Dim i As Long
Dim sChr As String
sInp = UCase(sInp)
For i = 1 To Len(sInp)
sChr = Mid(sInp, i, 1)
Select Case sChr
Case "0" To "9"
rd = rd & Chr(Asc("J") - Asc(sChr) + Asc("0"))
Case "A" To "I"
rd = rd & Chr(Asc(sChr) - Asc("A") + Asc("1"))
Case "J"
rd = rd & "0"
Case "K" To "Z"
rd = rd & Chr(Asc("Z") - Asc(sChr) + Asc("K"))
Case "-"
rd = rd & "."
Case Else
rd = rd & sChr
End Select
Next i
End FunctionA | B | |
1 | Now is the time for all good men | |
2 | WVN 9R Q85 Q9X5 6VS 1YY 7VV4 X5W | A2: =rd(A1) |
