calculate numbers using a key with VBA

1 Attachment(s)

Dear all,
I have a VBA formula (shown below) which calculates numbers which are multiple of 10 strings using a specific key (can be found in the attachment of the file in sheet2).

Attachment 8656

I would like to embed a new key into the formula below, which only calculates numbers which are NOT multiple of 10s (i.e 45s, 78 etc).

"IF a number is multiple of 10s THEN use the code function below, Else IF, the number is not multiple of 10 (79) THEN use the new key to convert the number."

My current code:

[VBA]Sub MG08Aug32()
Dim Rng As Range
Dim Dn As Range
Dim n As Integer
Dim Num As String
Set Rng = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
Columns("F:F").ClearContents
For Each Dn In Rng
'DO not run this function on rows which equal to CMBS.
If Not Dn.Offset(, 4) = "CMBS" Then
'if the values are 45a or 76h extract them as numebrs only.
For n = 1 To Len(Dn)
If IsNumeric(Mid(Dn, n, 1)) Or Mid(Dn, n, 1) = Chr(46) Then
Num = Num & Mid(Dn, n, 1)
End If
Next n
'If IsNumeric(Left(Dn, 1)) Or Len(Num) = Len(Dn) Then Dn.Offset(, 1) = Num
'Num = ""
If IsNumeric(Left(Dn, 1)) Or Len(Num) = Len(Dn) Then
Dn.Offset(, 1) = Num

ElseIf Num = "" Then
Select Case LCase(Dn)
'Teens
Case "teens": Dn.Offset(, 1) = 16
Case "vlteens": Dn.Offset(, 1) = 13

End Select

Else
Select Case UCase(Left(Dn, 1))
'Calculate VH multiples of 10s.
Case "V"
If UCase(Left(Dn, 2)) = "VL" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 1
ElseIf UCase(Left(Dn, 2)) = "VH" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 9
ElseIf UCase(Left(Dn, 4)) = "V HI" Then
Dn.Offset(, 1) = Val(Mid(Dn, 5, 3)) + 9
End If

Case "H"
'Calculate H multiple of 10s (H60s)
If UCase(Left(Dn, 2)) = "HI" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 8
Else
Dn.Offset(, 1) = Val(Mid(Dn, 2, 3)) + 8
End If

Case "L"
If UCase(Left(Dn, 2)) = "LM" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 2)) + 3.5
ElseIf UCase(Left(Dn, 3)) = "L/M" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 2
ElseIf UCase(Left(Dn, 3)) = "LOW" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 2
ElseIf UCase(Left(Dn, 3)) = "LO-" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 2
ElseIf UCase(Left(Dn, 6)) = "LO MID" Then
Dn.Offset(, 1) = Val(Mid(Dn, 7, 3)) + 3.5
ElseIf UCase(Left(Dn, 3)) = "LO " Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 2

'ElseIf UCase(Left(Dn, 1)) = "L" Then
'Dn.Offset(, 1) = Val(Mid(Dn, 2, 3)) + 2
ElseIf IsNumeric(Mid(Dn, 2, 1)) Then
Dn.Offset(, 1) = IIf(IsNumeric(Mid(Dn, 2, 1) + Mid(Dn, 3, 1)), Val(Mid(Dn, 2, 3)) + 2, Val(Mid(Dn, 2, 1)) + 0.2)

'Else
'Dn.Offset(, 1) = Val(Mid(Dn, 2, 1)) + 0.2
End If

Case "M"
If UCase(Left(Dn, 2)) = "MH" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 7
ElseIf UCase(Left(Dn, 2)) = "ML" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 3.5
ElseIf UCase(Left(Dn, 6)) = "MTeens" Then
Dn.Offset(, 1) = Val(Mid(Dn, 3, 3)) + 15

ElseIf UCase(Left(Dn, 3)) = "M/H" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 2)) + 7 'Or Val(Mid(Dn, 4, 1)) + 0.7

ElseIf UCase(Left(Dn, 4)) = "MID " Then
Dn.Offset(, 1) = Val(Mid(Dn, 5, 3)) + 5
ElseIf UCase(Left(Dn, 3)) = "MID" Then
Dn.Offset(, 1) = Val(Mid(Dn, 4, 3)) + 5
ElseIf UCase(Left(Dn, 7)) = "MID-HI " Then
Dn.Offset(, 1) = Val(Mid(Dn, 8, 3)) + 7
ElseIf UCase(Left(Dn, 5)) = "MID-HI" Then
Dn.Offset(, 1) = Val(Mid(Dn, 6, 3)) + 7
ElseIf UCase(Left(Dn, 4)) = "MID-" Then
Dn.Offset(, 1) = Val(Mid(Dn, 5, 3)) + 5
ElseIf IsNumeric(Mid(Dn, 2, 1)) Then
Dn.Offset(, 1) = IIf(IsNumeric(Mid(Dn, 2, 1) + Mid(Dn, 3, 1)), Val(Mid(Dn, 2, 2)) + 5, Val(Mid(Dn, 2, 1)) + 0.5)
End If

End Select
End If
If InStr(Dn, "-") Then
Dn.Offset(, 1) = Split(Dn, "-")(0)
End If
Num = ""
End If
Next Dn
End Sub
[/VBA]

Any help would be very much appreciated.

Thank you for your time and response.

What do you mean by a 'new key'?

1 Attachment(s)

The code above uses the original key which is shown below:

Original key table:

VLx--> +1
Lx --> +2
LMx --> +3.5
Mx --> +5
MHx --> +7
Hx --> +8
VHx --> +9
xA --> x

(x) number

The above key is used to calculate the numbers in sheet 1, which are multiple of 10s.

The new key table:

VLx --> + 0.1
Lx --> +0.2
LMx --> + 0.35
Mx --> +0.5
MHx --> +0.7
Hx --> +0.8
VHx --> +0.9

The new key above is used to calculate numbers in sheet 1, which are NOT multiple of 10s (m56s).

I hope this clarifies the problem.

I have attached the same file with a clearer representation of the output on sheet 1 and the code is behind sheet1.

Attachment 8657

Thank you for your help and time.

You have values in the code that are not in the key table, such as ML. Why not just enlarge the key table for all keys and reduce the code down to a few lines?