View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson[_4_] Greg Wilson[_4_] is offline
external usenet poster
 
Posts: 218
Default stuck please help

The following was my interpretation. My interpretation
of "remainder" may be in error but should be easily
fixed. If rewrote the code according to my own style.
Hope it's what you want.

Private Sub launchbutton_1_Click()
Dim LastRow As Long, LastCol As Integer
Dim X As Long, Y As Integer
Dim RunTot As Single, Parts As Single
Dim Remainder As Single, EmptyCell As Range
With Worksheets("First Sheet")
With .UsedRange
LastRow = .Row - 1 + .Rows.Count
LastCol = .Column - 1 + .Columns.Count
End With

For X = 2 To LastRow
On Error GoTo Skip
Y = 7
RunTot = 0
Parts = .Cells(X, 7).Value
Set EmptyCell = .Cells(X, LastCol + 1)
Do Until Y = LastCol Or RunTot Parts
Y = Y + 1
RunTot = RunTot + .Cells(X, Y).Value
If RunTot <= Parts Then
If .Cells(X, Y) < "" Then
.Cells(X, Y).Interior.ColorIndex = 6
Remainder = Parts - RunTot
Else
Set EmptyCell = .Cells(X, Y)
Exit Do
End If
End If
Loop
If Remainder < 0 Then _
Remainder = Remainder + .Cells(X, Y)
EmptyCell.Value = Remainder
EmptyCell.Interior.ColorIndex = 3
Skip:
Next X
End With

End Sub

Not rigorously tested. That's your job.

Regards,
Greg
(VBA amateur)