Thread: gauges
View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
emm emm is offline
external usenet poster
 
Posts: 7
Default gauges

Eric,

This is really cool! I have to fiddle a bit yet, but THANK YOU!

Emm

"EricG" wrote:

Emm,

I have updated the macro below. Note that this is an example, and you may
have to alter it to work in your particular situation. Steps to take to use
it:

1. Add a command button to the "Range" sheet. To do that, first go into
Design Mode (it's a button on the Visual Basic toolbar). The click on the
"Control Toolbox" button (also on the Visual Basic toolbar). Click on the
"Command Button". Click anywhere on the "Range" sheet. A new button, named
"CommandButton1" will be added to the sheet. You can select and move that
button to wherever you want it.

2. Right-click on the button, and select "View Code" from the menu. The
Visual Basic Editor will start up, and you will see a blank subroutine for
"CommandButton1_Click". Copy and paste the macro code below into that
subroutine.

3. Exit Design Mode by clicking on the "Design Mode" button again.

4. You should have your GaugeThicknesses range defined to start in cell A1,
with cell A1 being a header or label, and the gauge values being listed below
that.

5. In Cell C1, type "Target Value"

6. In cell C2, enter whatever target value you want to test.

7. Click on the button.

The code will find every combination of gauge thicknesses that add up to a
value that is less than or equal to the "Target Value". Where it finds an
exact match (and you can have more than one), it will color the total value
blue.

Here is the code to paste into the "CommandButton1_Click" subroutine. Be
careful to fix line wrap problems!

Dim i As Long, j As Long, k As Long, l As Long
Dim theRow, theCol
Dim nGauges As Long
Dim whichGauges() As Double
Dim targetGauge As Double
Dim totGauge As Double
'
ActiveSheet.Range("GaugeThicknesses").Select ' Named range listing gauges
nGauges = Selection.Rows.Count - 1 ' How many gauges are there?
theRow = Selection.Row ' Which row gauge list starts on
theCol = Selection.Column ' Which column gauge list starts on
'
' Clear out old data
'
ActiveSheet.Range(ActiveSheet.Cells(theRow + 1, theCol + 4), _
ActiveSheet.Cells(theRow + nGauges, theCol + 3 +
nGauges)).Select
Selection.Clear

'
' The target is two columns to the right of the gauge list.
'
targetGauge = ActiveSheet.Cells(theRow + 1, theCol + 2)
'
k = nGauges
l = -1
ReDim whichGauges(1)
'
' The "While" loop is an "outer loop" that goes through every possible
' combination of gages that will add up to a value that is less than
' or equal to the value of targetGauge. The results are displayed on
' the worksheet in columns to the right of the "Target" column.
'
While (k 0)
l = l + 1
totGauge = 0# ' Add gauges as we go
j = 0 ' Count number of gauges we add
For i = k To 1 Step -1 ' Assume gauge values go from small to large,
so go backwards here
'
' Note the "-0.00001" value - this was added because Excel has a
' weird roundoff glitch that sometimes results in 3.2 + 0.2 = 3.39999999
' (for example) instead of 3.4.
'
If (targetGauge - (totGauge + ActiveSheet.Cells(theRow + i,
theCol)) -0.00001) Then
'
' We can add the next smaller gauge and still be below or at targetGauge
'
j = j + 1
If (j = 1) Then k = i - 1
ReDim Preserve whichGauges(j) ' Store gauges that
add to total
whichGauges(j) = ActiveSheet.Cells(theRow + i, theCol)
totGauge = totGauge + whichGauges(j) ' Keep track of total
gauge thickness
End If
Next i
'
' We have all the Gauges the will fit within "targetGauge", now place
' them on the worksheet.
' NOTE: This does not guarantee an exact match if you don't have the
' right gauge thicknesses available!
'
For i = 1 To j
ActiveSheet.Cells(theRow + i, theCol + 4 + l) = whichGauges(i)
Next i
'
' Total this set of gauges
'
ActiveSheet.Cells(theRow + i, theCol + 4 + l).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & j & "]C:R[-1]C)"
ActiveCell.Font.Bold = True
If (Abs(ActiveCell.Value - targetGauge) < 0.000001) Then
ActiveCell.Font.ColorIndex = 5 ' Color it blue if it matches
Wend ' Next "outer loop"
'