Insert Rows / Find Cell based on Shading

[Philcjr]

Need some help J

Objective: to figure out when a given ending inventory will run out based upon total demand.



? I have a spreadsheet with 30+ items/SKUs that have a forecast.

? I need to insert a row, three rows below the item/SKU which is in Column A (this code is already written)

? There will always be one column that is shaded (this indicates where I need to start)

? Once I insert the row, I need to move to the right until I encounter a cell that is shaded. (.Interior.ColorIndex <> xlNone)

? I need to shade those cells of the newly inserted row a light blue (?B:N?)

? Once I find that cell, I need to copy the cell?s value (Ending Inventory) that is one row above and one cell to the left.

? With that value, I need to subtract the ?Total Demand? until I reach a zero or, to have what percent of the next month is covered



I have attached a sample so that you can see what I am taking about

[acw]

Hi

Try the following


Option Explicit
Private Sub DOS()
Dim r As Integer
Dim i As Integer
With Sheets("Sheet1")
For r = .Range("A65536").End(xlUp).Row To 1 Step -1
If Not IsEmpty(.Range("A" & r)) Then
.Rows(r + 3).Insert
Range(Cells(r + 3, 2), Cells(r + 3, 14)).Interior.ColorIndex = 34
i = 1
While Cells(r + 2, i).Interior.ColorIndex = xlNone
i = i + 1
Wend
Cells(r + 3, i - 1).Value = Cells(r + 2, i - 1).Value
Cells(r + 3, i).Formula = "=" & Cells(r + 3, i - 1).Address(rowabsolute:=False, columnabsolute:=False) & "-" & Cells(r, i).Address(rowabsolute:=False, columnabsolute:=False)
While Cells(r + 3, i) > 0
i = i + 1
Cells(r + 3, i).Formula = "=" & Cells(r + 3, i - 1).Address(rowabsolute:=False, columnabsolute:=False) & "-" & Cells(r, i).Address(rowabsolute:=False, columnabsolute:=False)
Wend
End If
Next r
End With
End Sub



Tony

[Philcjr]

Tony,
Many thanks :bow: for your effort in creating this coding. Your code works perfectly. In an effort to understand what you did and to teach myself, I modified your code as follows:



Option Explicit
Public R As Integer
Public I As Integer

Private Sub DOS()
With Sheets("Inventory Cutover Timing")
For R = .Range("B65536").End(xlUp).Row To 159 Step -1
If Range("B" & R).Text = "ENDING INVENTORY" Then
.Rows(R + 1).Insert
'Shades in row B:AA with light blue
Range(Cells(R + 1, 2), Cells(R + 1, 27)).Interior.ColorIndex = 34
'Searches for the column with shading
I = 1
While Cells(R, I).Interior.ColorIndex = xlNone
I = I + 1
Wend
'Places the "Ending Inventory" into cell within the new row
Cells(R + 1, I - 1).Value = Cells(R, I - 1).Value
DOS_CALC
'Checks to make sure the prior month is not less then 0
While Cells(R + 1, I) > 0
I = I + 1
DOS_CALC
Wend
End If
Next R
End With
End Sub

Function DOS_CALC()
Cells(R + 1, I).Formula = "=" & _
Cells(R + 1, I - 1).Address & "-" & Cells(R - 2, I).Address
End Function


I have a problem that I didn't realize, the file in which I need to perform this task has hidden rows...YUK!

Is there a way that this code could perform ONLY on visible rows?

Again,
THANK YOU!!!!!!!

Phil

[acw]

Phil

1) Visible rows - Just a thought but as you go through the rows, check the hidden status as part of the testing. Only action if it is visible and meets the other criteria.

2) I notice that you have taken out the formula generating process and put it into a function. A function should only be used to perform some actions that return a result. So change it to a sub rather than a function. Also, as it is only one line there is really no need to separate - unless you can use this in other parts of the code not just this particular sub.


Tony

[Philcjr]

Thanks Tony for your input.

This is what I did? Would you have tested to see if a row was hidden differently?


Option Explicit
Public R As Integer
Public I As Integer

Private Sub DOS()
With Sheets("Inventory Cutover Timing")
For R = .Range("B65536").End(xlUp).Row To 159 Step -1
If Rows(R).Hidden = True Then GoTo HiddenRow
If Range("B" & R).Text = "ENDING INVENTORY" Then
.Rows(R + 1).Insert
'Shades in the inserted row "B:AA" light blue
Range(Cells(R + 1, 2), Cells(R + 1, 27)).Interior.ColorIndex = 34
'Search for the column with shading
I = 1
While Cells(R, I).Interior.ColorIndex = xlNone
I = I + 1
Wend
'Places the "Ending Inventory" into cell within the new row
Cells(R + 1, I - 1).Value = Cells(R, I - 1).Value
Cells(R + 1, I).Formula = "=" & _
Cells(R + 1, I - 1).Address & "-" & Cells(R - 2, I).Address
'Checks to make sure the prior month is not less then 0
While Cells(R + 1, I) > 0
I = I + 1
Cells(R + 1, I).Formula = "=" & _
Cells(R + 1, I - 1).Address & "-" & Cells(R - 2, I).Address
Wend
End If
HiddenRow:
Next R
End With
End Sub


Any tips or tweaks are always welcome.

Phil

[acw]

Hi

More like



If Range("B" & R).Text = "ENDING INVENTORY" and rows(r).hidden = false Then


and don't have the goto etc.


Tony

[Philcjr]

Thanks for all your help!