stuck please help

[derekc]

i posted this before but i think it was way comfusing.
i have a spreadsheet we download once a week. i have code written to d
what i want so far. it basically subtracts how many parts we owe dif
companies from what we have on hand. i have it to subtract until i
hits a negative number , then highlight the last date we ca
ship.(written by pikus) what i have been trying to do, and failing a
it since then, is have the remainder left over to show in the firs
emtpy cell at the end of the row, and highlight it.

ex:

the on hand number starts in g4, then it goes down the row subtractin
until it hits a neg number. then the last positive number used needs t
be placed at the first empty cell at the end of that row. the
highlighted.

if anything of this is possible i appreciate it, here is the code as i
is now.

Private Sub launchbutton_1_Click()

lastRow = Worksheets("First Sheet").UsedRange.Row - 1
Worksheets("First Sheet").UsedRange.Rows.Count
lastCol = Worksheets("First Sheet").UsedRange.Column - 1
Worksheets("First Sheet").UsedRange.Columns.Count

With Worksheets("First Sheet")
For x = 2 To lastRow
On Error GoTo Skip
y = 7
runTot = 0
parts = .Cells(x, 7).Value
Do Until y = lastCol _
Or runTot > parts
y = y + 1
runTot = runTot + .Cells(x, y).Value
Loop
If runTot > parts Then
For z = 8 To y - 1
.Cells(x, z).Interior.ColorIndex = 6
Next z
ElseIf y = lastCol Then
For z = 8 To y
If .Cells(x, z).Value <> "" Then
.Cells(x, z).Interior.ColorIndex = 6
End If
Next z
End If
Skip:
Next x

End With
End Sub


thank

 

[Greg Wilson]

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)

 

[Greg Wilson]

I forgot to remove the following lines. They are
unnecessary:

If Remainder < 0 Then _
Remainder = Remainder + .Cells(X, Y)

Regards,
Greg