juliusdarius
New Member
- Joined
- Jul 23, 2016
- Messages
- 2
Good evening,
I am creating a program that farmers and agricultural producers will be able to use to find the dimensions for a dike wall that will ensure an oil spill from tanks in it will be contained. I have a macro that will ask for the length and width and I want to solve for the height.
The equation is essentially LargestTankVolume = L * W * H-Sum(Tank Displacements). I can have the macro figure out the max volume so I know LargestTankVolume and they supply Length and Width. The issue I am facing is having excel determine the displacement. The displacement formula is different based on if the tank is vertical or horizontal, and depends on the quantity of tanks. So I need something like LargestTankVolume = L*W*H-Vol1-Vol2-Vol3....
I am trying to get a way for excel to solve the equation for H. So really I need a way for vba to look at each column, determine if it horizontal or vertical, plug the numbers into the formula, then have it be subtracted from the L* W *H
Here is the code I have so far
Option Explicit
Sub NoInput()
Dim strInputDiameter As String
strInputDiameter = Application.InputBox("Tank Diameter") 'get diameter inputs
Dim strInputLength As String
strInputLength = Application.InputBox("Tank Length") 'get length inputs
Dim strInputOrientation As String
strInputOrientation = Application.InputBox("Orientation")
'convert comma separated inputs to arrays of Doubles
Dim dblDiameter() As Double
dblDiameter() = str_to_double_array(csv_to_string_array(strInputDiameter))
Dim dblLength() As Double
dblLength() = str_to_double_array(csv_to_string_array(strInputLength))
Dim strOrientationArray() As String
strOrientationArray() = Split(strInputOrientation, ",")
Dim rngCurrCell As Range
Set rngCurrCell = ActiveSheet.Range("A1")
'set number of containers to whichever input had the least values
Dim intContainerCount As Integer
intContainerCount = WorksheetFunction.Min(UBound(dblDiameter), UBound(dblLength))
'calculate volume for each container, output to sheet
Dim i As Integer
For i = 1 To intContainerCount
rngCurrCell.Value = "Diameter " & i
rngCurrCell.Offset(0, 1).Value = dblDiameter(i)
rngCurrCell.Offset(1, 0).Value = "Length " & i
rngCurrCell.Offset(1, 1).Value = dblLength(i)
rngCurrCell.Offset(2, 0).Value = "Volume " & i
rngCurrCell.Offset(2, 1).Value = calc_cylinder_volume(dblDiameter(i), dblLength(i))
rngCurrCell.Offset(3, 0).Value = "Orientation " & i
rngCurrCell.Offset(3, 1).Value = strOrientationArray(i - 1)
Set rngCurrCell = rngCurrCell.Offset(0, 3)
Next i
Call Largest
End Sub
Function csv_to_string_array(strCSV As String) As String()
csv_to_string_array = Split("," & strCSV, ",") 'don't know why, but needs a leading comma otherwise it skips the first input
End Function
Function str_to_double_array(strArray() As String) As Double()
Dim tempDblArray() As Double
ReDim tempDblArray(UBound(strArray))
Dim i As Integer
For i = 1 To UBound(strArray)
tempDblArray(i) = CDbl(strArray(i))
Next i
str_to_double_array = tempDblArray()
End Function
Function calc_cylinder_volume(dblDiameter As Double, dblLength As Double) As Double
calc_cylinder_volume = (Application.WorksheetFunction.Pi() * ((dblDiameter / 2) ^ 2) * dblLength)
End Function
Sub Largest()
'Cells with dates also return a value, and get covered for determining largest value. Percentages will convert and return numerics.
Dim rng As Range
Dim dblMax As Double
'Set range from which to determine largest value
Set rng = Sheet1.Range("A1:Z100")
'Worksheet function MAX returns the largest value in a range
dblMax = Application.WorksheetFunction.Max(rng)
'Displays largest value
MsgBox dblMax
End Sub
View attachment 471943
I am creating a program that farmers and agricultural producers will be able to use to find the dimensions for a dike wall that will ensure an oil spill from tanks in it will be contained. I have a macro that will ask for the length and width and I want to solve for the height.
The equation is essentially LargestTankVolume = L * W * H-Sum(Tank Displacements). I can have the macro figure out the max volume so I know LargestTankVolume and they supply Length and Width. The issue I am facing is having excel determine the displacement. The displacement formula is different based on if the tank is vertical or horizontal, and depends on the quantity of tanks. So I need something like LargestTankVolume = L*W*H-Vol1-Vol2-Vol3....
I am trying to get a way for excel to solve the equation for H. So really I need a way for vba to look at each column, determine if it horizontal or vertical, plug the numbers into the formula, then have it be subtracted from the L* W *H
Here is the code I have so far
Option Explicit
Sub NoInput()
Dim strInputDiameter As String
strInputDiameter = Application.InputBox("Tank Diameter") 'get diameter inputs
Dim strInputLength As String
strInputLength = Application.InputBox("Tank Length") 'get length inputs
Dim strInputOrientation As String
strInputOrientation = Application.InputBox("Orientation")
'convert comma separated inputs to arrays of Doubles
Dim dblDiameter() As Double
dblDiameter() = str_to_double_array(csv_to_string_array(strInputDiameter))
Dim dblLength() As Double
dblLength() = str_to_double_array(csv_to_string_array(strInputLength))
Dim strOrientationArray() As String
strOrientationArray() = Split(strInputOrientation, ",")
Dim rngCurrCell As Range
Set rngCurrCell = ActiveSheet.Range("A1")
'set number of containers to whichever input had the least values
Dim intContainerCount As Integer
intContainerCount = WorksheetFunction.Min(UBound(dblDiameter), UBound(dblLength))
'calculate volume for each container, output to sheet
Dim i As Integer
For i = 1 To intContainerCount
rngCurrCell.Value = "Diameter " & i
rngCurrCell.Offset(0, 1).Value = dblDiameter(i)
rngCurrCell.Offset(1, 0).Value = "Length " & i
rngCurrCell.Offset(1, 1).Value = dblLength(i)
rngCurrCell.Offset(2, 0).Value = "Volume " & i
rngCurrCell.Offset(2, 1).Value = calc_cylinder_volume(dblDiameter(i), dblLength(i))
rngCurrCell.Offset(3, 0).Value = "Orientation " & i
rngCurrCell.Offset(3, 1).Value = strOrientationArray(i - 1)
Set rngCurrCell = rngCurrCell.Offset(0, 3)
Next i
Call Largest
End Sub
Function csv_to_string_array(strCSV As String) As String()
csv_to_string_array = Split("," & strCSV, ",") 'don't know why, but needs a leading comma otherwise it skips the first input
End Function
Function str_to_double_array(strArray() As String) As Double()
Dim tempDblArray() As Double
ReDim tempDblArray(UBound(strArray))
Dim i As Integer
For i = 1 To UBound(strArray)
tempDblArray(i) = CDbl(strArray(i))
Next i
str_to_double_array = tempDblArray()
End Function
Function calc_cylinder_volume(dblDiameter As Double, dblLength As Double) As Double
calc_cylinder_volume = (Application.WorksheetFunction.Pi() * ((dblDiameter / 2) ^ 2) * dblLength)
End Function
Sub Largest()
'Cells with dates also return a value, and get covered for determining largest value. Percentages will convert and return numerics.
Dim rng As Range
Dim dblMax As Double
'Set range from which to determine largest value
Set rng = Sheet1.Range("A1:Z100")
'Worksheet function MAX returns the largest value in a range
dblMax = Application.WorksheetFunction.Max(rng)
'Displays largest value
MsgBox dblMax
End Sub
View attachment 471943