Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
stuck please help
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 -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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) |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
stuck please help
I forgot to remove the following lines. They are
unnecessary: If Remainder < 0 Then _ Remainder = Remainder + .Cells(X, Y) Regards, Greg |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Im stuck again... | Excel Discussion (Misc queries) | |||
Help, please, I'm stuck | Excel Discussion (Misc queries) | |||
Stuck... | Excel Discussion (Misc queries) | |||
Stuck with an =IF | Excel Worksheet Functions | |||
Still Stuck | Excel Programming |