converting formula's to vb script

[stilgar]

I have an excel sheet with formula's setup but they are too long for what i need so i want to use vb script to do the functions instead.

<TABLE style="WIDTH: 449pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=598 x:str><COLGROUP><COL style="WIDTH: 247pt; mso-width-source: userset; mso-width-alt: 12032" width=329><COL style="WIDTH: 29pt; mso-width-source: userset; mso-width-alt: 1426" width=39><COL style="WIDTH: 173pt; mso-width-source: userset; mso-width-alt: 8411" width=230><TBODY><TR style="HEIGHT: 15pt; mso-height-source: userset" height=20><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: #ffff99; WIDTH: 247pt; HEIGHT: 15pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid" class=xl28 height=20 width=329>35mm x 150mm Skirting Duct</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; WIDTH: 29pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27 width=39></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: #ccffcc; WIDTH: 173pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid" class=xl24 width=230 x:str=""></TD></TR><TR style="HEIGHT: 15pt; mso-height-source: userset" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27 height=20></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: #ccffcc; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid" class=xl25>PL35150DN</TD></TR><TR style="HEIGHT: 15pt; mso-height-source: userset" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27 height=20></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: #ccffcc; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid" class=xl25 x:str=""></TD></TR><TR style="HEIGHT: 15pt; mso-height-source: userset" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl29 height=20 x:str=""></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: silver; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl27></TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: #ccffcc; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid" class=xl26 x:str=""></TD></TR></TBODY></TABLE>

this is the current setup i have which i have to use 4 cells to display results as the formula's are too long. i'd like to have it so i only had cell d7 display results. the green cells are D7, D8, D9, D10 with the 35mm cell being B7. These formulars also rely on the drop down menu in B21 which has 5 selections.

current formulars are:

d7:
=IF(AND(B7="35mm x 125mm Skirting Duct",B21="BLACK"),"PL35125DB",IF(AND(B7="35mm x 125mm Skirting Duct",B21="WHITE"),"PL35125DW",IF(AND(B7="35mm x 125mm Skirting Duct",B21="OPAL GREY"),"PL35125DO",IF(AND(B7="35mm x 125mm Skirting Duct",B21="NATURAL ANODISED"),"PL35125DN",IF(AND(B7="35mm x 125mm Skirting Duct",B21="POWDERCOATED"),"PL35125DS","")))))

d8:
=IF(AND(B7="35mm x 150mm Skirting Duct",B21="WHITE"),"PL35150DW",IF(AND(B7="35mm x 150mm Skirting Duct",B21="BLACK"),"PL35150DB",IF(AND(B7="35mm x 150mm Skirting Duct",B21="OPAL GREY"),"PL35150DO",IF(AND(B7="35mm x 150mm Skirting Duct",B21="NATURAL ANODISED"),"PL35150DN",IF(AND(B7="35mm x 150mm Skirting Duct",B21="POWDERCOATED"),"PL35150DS","")))))

d9:
=IF(AND(B7="50mm x 150mm Skirting Duct",B21="BLACK"),"PL50150DB",IF(AND(B7="50mm x 150mm Skirting Duct",B21="WHITE"),"PL50150DW",IF(AND(B7="50mm x 150mm Skirting Duct",B21="OPAL GREY"),"PL50150DO",IF(AND(B7="50mm x 150mm Skirting Duct",B21="NATURAL ANODISED"),"PL50150DN",IF(AND(B7="50mm x 150mm Skirting Duct",B21="POWDERCOATED"),"PL50150DS","")))))

d10:
=IF(AND(B7="50mm x 200mm Skirting Duct",B21="BLACK"),"PL50200DB",IF(AND(B7="50mm x 200mm Skirting Duct",B21="WHITE"),"PL50200DW",IF(AND(B7="50mm x 200mm Skirting Duct",B21="OPAL GREY"),"PL50200DO",IF(AND(B7="50mm x 200mm Skirting Duct",B21="NATURAL ANODISED"),"PL50200DN",IF(AND(B7="50mm x 200mm Skirting Duct",B21="POWDERCOATED"),"PL50200DS","")))))

there are other examples on this sheet which i hope to convert aswell but if i can get this one to work then i should be able to do the rest myself.

any help is welcome

 

[pbornemeier]

The first procedure calculates only D7, the last procedure calculates all:

Sub CalculateCellD7()

    Dim sSerNum As String
    If Range("B7").Value = "35mm x 125mm Skirting Duct" Then
        Select Case Range("B21").Value
        Case "BLACK": sSerNum = "PL35125DB"
        Case "WHITE": sSerNum = "PL35125DW"
        Case "OPAL GREY": sSerNum = "PL35125DO"
        Case "NATURAL ANODISED": sSerNum = "PL35125DN"
        Case "POWDERCOATED": sSerNum = "PL35125DS"
        Case Else: sSerNum = ""
        End Select
    End If
    
    Range("B7").Value = sSerNum
    
End Sub

Sub CalculatePartNumber()

    Dim sPartial As String
    Dim sDuctPartNumber As String
    Dim sCell As String
    
    sDuctPartNumber = "PL"
    
    Select Case Range("B7").Value
    Case "35mm x 125mm Skirting Duct": sPartial = "35125": sCell = "D7"
    Case "35mm x 150mm Skirting Duct": sPartial = "35150": sCell = "D8"
    Case "50mm x 150mm Skirting Duct": sPartial = "50150": sCell = "D9"
    Case "50mm x 200mm Skirting Duct": sPartial = "50200": sCell = "D10"
    Case Else: sPartial = "XXXXX": MsgBox "Invalid dimensions": GoTo End_Sub
    End Select
    sDuctPartNumber = sDuctPartNumber & sPartial & "D"
    
    Select Case Range("B21").Value
    Case "BLACK": sPartial = "B"
    Case "WHITE": sPartial = "W"
    Case "OPAL GREY": sPartial = "O"
    Case "NATURAL ANODISED": sPartial = "N"
    Case "POWDERCOATED": sPartial = "S"
    Case Else: sPartial = "X": MsgBox "Invalid color": GoTo End_Sub
    End Select
    sDuctPartNumber = sDuctPartNumber & sPartial
    
    If InStr(sDuctPartNumber, "X") > 0 Then sDuctPartNumber = ""
    
    Range(sCell) = sDuctPartNumber

End_Sub:

End Sub

 

[stilgar]

Sweet! works a treat! thanks