gauges

[emm]

I would like to create a formula or a macro that will display a list of
gauges to use to reach a specific size.
I have a table with gauge sizes.
I want to enter a size in a cell and have another cell(s) list the smallest
number of different gauges that I need to make that size.
For example: The table may contain 3, 3.5, 3.2. 2.7, 0.4, 0.2 and etc. If
I enter 3.4 in the size cell, then 3.2 and .2 appear in the list.

Any suggestions are appreciated,
Emm

 

[EricG]

Are your gauge sizes really that random?

Here is a macro the might give you an idea for how to do this. I made some
assumptions about where data are on the worksheet, including the existence of
a named range "GageThicknesses" that contains a list of all the gages, in
order from smallest to largest. I linked the macro to a command button on
the sheet, but you can also use it by itself.

Modify to suit your needs.

Private Sub CommandButton1_Click()
Dim i As Long, j 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
'
' The target is two columns to the right of the gauge list
'
targetGauge = ActiveSheet.Cells(theRow + 1, theCol + 2)
'
totGauge = 0# ' Add gauges as we go
j = 0 ' Count number of gauges we add
For i = nGauges To 1 Step -1 ' Assume Gauges go small to large, go
backwards here
If (targetGauge - (totGauge + ActiveSheet.Cells(theRow + i, theCol))

-0.0001) Then

j = j + 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) = whichGauges(i)
Next i
'
End Sub

 

[emm]

Eric,
No, the gauges are not that random, but there are a lot of them. I wanted
to show a range of possibilities and just use a sampling to experiment.

After seeing your macro, I see that I don't understand them very well.
How do I indicate "theRow ="? I named the range GaugeThicknesses and it is
located on the Range sheet column A rows 1 through 6.
Then, is the targetGauge and the CommandButton located on a sheet named Cells?

Thank you so much for your time,
Emm

 

[EricG]

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"
'

 

[emm]

Eric,

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

Emm

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"
'