Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
gauges
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
gauges
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" wrote: 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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
gauges
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" wrote: 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" wrote: 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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
gauges
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" ' |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
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" ' |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|