converting formula's to vb script

stilgar

Board Regular
Joined
Feb 28, 2011
Messages
51
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 :)
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
The first procedure calculates only D7, the last procedure calculates all:
Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top