junaid44
08-23-2012, 04:03 AM
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).
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:
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
Any help would be very much appreciated.
Thank you for your time and response.
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).
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:
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
Any help would be very much appreciated.
Thank you for your time and response.