PDA

View Full Version : VBA to Test Outcomes of Drop Down Selections



nirvehex
06-29-2015, 11:12 AM
Hey guys,

I'm trying to figure out some VBA code to test the following:

In column AB I have a drop down list that has the following 4 choices, "New Equipment", "Rent Equipment", "Preventative Maintenance", and "No Change". These generate an outcome in column AS. The values are in rows AB2:to End of sheet-1 row (I have a total in the last row). Same thing with column AS. AS is a percentage figure (ROI).

What I'm trying to do is see which choice in column AB generates the highest number in column AS and then keep that selection in column AB as the active selection.

Essentially the macro should do the following for each row in column AB from AB2 to end of rows -1.

Set AB2 = "New Equipment"
What's the value in AS2?
Set AB2 = "Rent Equipment"
What's the value in AS2?
Set AB2 = "Preventative Maintenance"
What's the value in AS2?
Set AB2 = "No Change"
What's the value in AS2?

Which value in AB2 generated the highest number in AS2? Set AB2 to the value that generated the highest number in AS2.

Repeat this from row 2 down to end -1 row.

Any ideas?

Thanks.

Also this is cross posted in slightly different wording at http://www.mrexcel.com/forum/excel-questions/864709-visual-basic-applications-do-what-if-testing.html

SamT
06-29-2015, 12:41 PM
I assume that AS2 increments by Row?

Repeat this from row 2 down to end -1 row.

I'll get back to you if no one else does,

nirvehex
06-29-2015, 12:50 PM
Yes, that is correct. And thank you!

SamT
06-29-2015, 01:39 PM
Put this in a standard Module and run it from the Tools >> Macros Menu. It may take some time to complete. Be patient and wait for the completion message. If you want to watch it run, (it will take longer,) change the first "ScreenUpdating" to "True."


Option Explicit

Sub SamT()
Dim ColumnAB As Range
Dim Cel As Range
Dim Value1 As Double
Dim Value2 As Double
Dim Value3 As Double
Dim Value4 As Double
Dim MaxValue As Double
Dim WsF As Object

With Application
Set WsF = .WorksheetFunction
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
'If there is a nonempty cell at the bottom of Column AB, then add ".Offset(-1)"
' before the final ")" at the end of the line below.
Set ColumnAB = Range(Range("AB2"), Range("AB2").End(xlDown))

For Each Cel In ColumnAB
Cel.Value = "New Equipment"
.Calculate
DoEvents
Value1 = Range("AS" & Cel.Row).Value

Cel.Value = "Rent Equipment"
.Calculate
DoEvents
Value2 = Range("AS" & Cel.Row).Value

Cel.Value = "Preventative Maintenance"
.Calculate
DoEvents
Value3 = Range("AS" & Cel.Row).Value

Cel.Value = "No Change"
.Calculate
DoEvents
Value4 = Range("AS" & Cel.Row).Value

MaxValue = WsF.Max(Value1, Value2, Value3, Value4)
Select Case MaxValue
Case Is = Value1: Cel.Value = "New Equipment"
Case Is = Value2: Cel.Value = "Rent Equipment"
Case Is = Value3: Cel.Value = "Preventative Maintenance"
Case Is = Value4: Cel.Value = "No Change"
End Select

.Calculate
DoEvents

Next Cel
End With

Set WsF = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

MsgBox "All trials complete"

End Sub

nirvehex
06-30-2015, 07:19 AM
Hey this works pretty well! Thank you. I did notice one thing though. If I run the macro when I'm on any other sheet on the work book, it keeps running and running and I can't even escape out of it. It only works when I run the macro while I'm on that specific sheet tab. Any ideas? Thanks!