View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Mark Ivey[_3_] Mark Ivey[_3_] is offline
external usenet poster
 
Posts: 22
Default Look down column and enter blank row and color grey

Sorry so long... got a b-day party going on over here for my son. He is
turning 2 today... wahoo!

See if this code fits the situation...

Mark Ivey

'*********Code starts here

Sub totalByName()
Dim LastRowColE As Long
Dim i As Long
Dim myRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRowColE = Range("E11").End(xlDown).Row
myRow = 11
i = 11

While i < LastRowColE
If Cells(myRow, 5).Value < Cells(myRow + 1, 5).Value Then
Cells(myRow + 1, 5).EntireRow.Insert
Cells(myRow + 1, 5).EntireRow.Insert
Range("A" & myRow + 1 & ":Q" & myRow + 1).Interior.ColorIndex =
15
myRow = myRow + 2
LastRowColE = LastRowColE + 2
End If
myRow = myRow + 1
i = i + 1
Wend

For i = 11 To LastRowColE
If Cells(i, 5).Value = "" Then
If Cells(i - 2, 1).Value < "" Then
Cells(i, 7).Value = "=Sum(" & Cells(i - 1, 7).Address & ":"
& _
Cells(i - 1, 7).End(xlUp).Address & ")"
Cells(i, 9).Value = "=Sum(" & Cells(i - 1, 9).Address & ":"
& _
Cells(i - 1, 9).End(xlUp).Address & ")"
Cells(i, 11).Value = "=Sum(" & Cells(i - 1, 11).Address &
":" & _
Cells(i - 1, 11).End(xlUp).Address & ")"
Cells(i, 13).Value = "=Sum(" & Cells(i - 1, 13).Address &
":" & _
Cells(i - 1, 13).End(xlUp).Address & ")"
Cells(i, 15).Value = "=Sum(" & Cells(i - 1, 15).Address &
":" & _
Cells(i - 1, 15).End(xlUp).Address & ")"
Cells(i, 17).Value = "=Sum(" & Cells(i - 1, 17).Address &
":" & _
Cells(i - 1, 17).End(xlUp).Address & ")"
i = i + 1
ElseIf Cells(i - 2, 1).Value = "" Then
Cells(i, 7).Value = Cells(i - 1, 7).Value
Cells(i, 9).Value = Cells(i - 1, 9).Value
Cells(i, 11).Value = Cells(i - 1, 11).Value
Cells(i, 13).Value = Cells(i - 1, 13).Value
Cells(i, 15).Value = Cells(i - 1, 15).Value
Cells(i, 17).Value = Cells(i - 1, 17).Value
i = i + 1
End If
End If
Next

For i = 11 To LastRowColE
If Cells(i, 7).Value = "" Then
Cells(i, 7).EntireRow.Delete
End If
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub