View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bagman Bagman is offline
external usenet poster
 
Posts: 5
Default Search Columns For Change, Insert Blank Rows, and Sum Differen

Thanks for the help! This will make things much easier.

"merjet" wrote:

Try this, with the sheet with the data being the active one.

Sub InsertRowsSums()
Dim iRow As Long
Dim iFirst As Long
Dim aColA As String
Dim aColB As String
iRow = 2
iFirst = 2
aColA = Cells(iRow, 1)
aColB = Cells(iRow, 2)
Do
iRow = iRow + 1
If Cells(iRow, 1) < aColA Or Cells(iRow, 2) < aColB Then
Rows(iRow & ":" & iRow + 1).Insert Shift:=xlDown
str1 = "D" & iFirst & ":D" & iRow - 1
Cells(iRow, 4).Formula = "=Sum(" & str1 & ")"
Cells(iRow, 4).Copy Range(Cells(iRow, 5), Cells(iRow, 7))
iRow = iRow + 2
iFirst = iRow
aColA = Cells(iRow, 1)
aColB = Cells(iRow, 2)
End If
Loop Until Cells(iRow, 1) = ""
End Sub

Hth,
Merjet