Home |
Search |
Today's Posts |
#5
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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" ' |