1. Registered User
Join Date
Apr 2004
Posts
7

I already have a macro that will compare items in column A and then add 3 blank lines if there are different. I did this to assit in grouping of items. For instance if there are two locations like this

CHI
CHI
KAS

Once the macro is run it will look like this

CHI
CHI

KAS

Want I want to achieve is while adding the 3 blank rows I need a sum calculation from another column(s) and an average from others. For example columns K, L, N, O, Q need to be summed and columns MPR need to be averaged. The end result would look very similar to access's grouping ability and summary in reports. Can anyone offer some advice on how to achieve this. I attached a word doc with the test data im working with if it makes more sense to look at. I have the test file Im working with and can send it via email if it makes more sense to look at it. This is the macro code to add the 3 blank lines.

Sub InsertRow_A_Chg()
Dim irow As Long, vcurrent As String, i As Long
'// find last used cell in Column A
irow = Cells(Rows.Count, "A").End(xlUp).Row
'// get value of that cell in Column A (column 1)
vcurrent = Cells(irow, 1).Value
'// rows are inserted by looping from bottom
For i = irow To 2 Step -1
If Cells(i, 1).Value <> vcurrent Then
vcurrent = Cells(i, 1).Value
Rows(i + 1).Insert
Rows(i + 1).Insert
Rows(i + 1).Insert
End If
Next i
End Sub

2. Registered User
Join Date
Apr 2004
Location
Derbyshire, UK
Posts
805
I assume that the data in colum "A" is continous ase you have used xlup so this routine should do it.

Sub InsertSumAverage()
Dim iSearchCol As Integer
Dim iSumCol1 As Integer
Dim iAveCol1 As Integer
Dim iTopRow As Integer
Dim iBotRow As Integer
Dim iRow As Integer

iSearchCol = Columns("A").Column

iSumCol1 = Columns("K").Column

iAveCol1 = Columns("M").Column

iRow = 2
Do While Cells(iRow, iSearchCol) <> ""
iTopRow = iRow
iRow = iRow + 1
Do While Cells(iTopRow, iSearchCol) = Cells(iRow, iSearchCol) And Cells(iRow, iSearchCol) <> ""
iRow = iRow + 1
Loop
iBotRow = iRow - 1

Cells(iRow, iSumCol1) = "=SUM(" & Cells(iTopRow, iSumCol1).Address & ":" & Cells(iBotRow, iSumCol1).Address & ")"

Cells(iRow, iAveCol1) = "=AVERAGE(" & Cells(iTopRow, iAveCol1).Address & ":" & Cells(iBotRow, iAveCol1).Address & ")"

iRow = iRow + 3
Loop
End Sub

You can define as many iSumCol? & IAveCol? as required.

MTB

3. Registered User
Join Date
Apr 2004
Posts
7
Mike,

Thank you so much!! I really appreciate it. I knew I was on the verge of trying to develop such a monster I just couldnt get to it. Once again my thanks

Rick

4. Registered User
Join Date
Apr 2004
Posts
7
Originally posted by MikeTheBike
I assume that the data in colum "A" is continous ase you have used xlup so this routine should do it.

Sub InsertSumAverage()
Dim iSearchCol As Integer
Dim iSumCol1 As Integer
Dim iAveCol1 As Integer
Dim iTopRow As Integer
Dim iBotRow As Integer
Dim iRow As Integer

iSearchCol = Columns("A").Column

iSumCol1 = Columns("K").Column

iAveCol1 = Columns("M").Column

iRow = 2
Do While Cells(iRow, iSearchCol) <> ""
iTopRow = iRow
iRow = iRow + 1
Do While Cells(iTopRow, iSearchCol) = Cells(iRow, iSearchCol) And Cells(iRow, iSearchCol) <> ""
iRow = iRow + 1
Loop
iBotRow = iRow - 1

Cells(iRow, iSumCol1) = "=SUM(" & Cells(iTopRow, iSumCol1).Address & ":" & Cells(iBotRow, iSumCol1).Address & ")"

Cells(iRow, iAveCol1) = "=AVERAGE(" & Cells(iTopRow, iAveCol1).Address & ":" & Cells(iBotRow, iAveCol1).Address & ")"

iRow = iRow + 3
Loop
End Sub

You can define as many iSumCol? & IAveCol? as required.

MTB

Incidently,

Is there a way to add a blank row, and then do the calculations, and then add the blank rows. Sorry to ask so much of you, but Im still learning the wonders of VB

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•