Inserted rows, now need Counta function

[Adam]

Hi

I've got a data dump. I've figured out how to insert a blank row after a
change in name in column A and insert "Total" - so...

bill....
bill....
bill Total -
bob....
bob....
bob....
bob Total -

What I need in column C next to total is to insert the COUNTA function for
each person.

Any ideas?

cheers

 

[Rick Rothstein]

You say your code inserts a blank row after a change in name and inserts
"Total", but your example doesn't show this. Can you post the code you are
using to do your "insert"? It will probably be easier to handle the
insertion of the COUNTA function at the same time the word "Total" is
inserted.

 

[Adam]

It's not beautijful but it works so far!


Range("A5").Select

Do Until Len(ActiveCell) = 0
If ActiveCell.Offset(1, 0) = ActiveCell Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(0, 1).Copy
ActiveCell.Offset(1, 1).PasteSpecial
ActiveCell.Offset(-1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(0, 1).Value = "TOTAL"
ActiveCell.EntireRow.Font.ColorIndex = 3
ActiveCell.Offset(1, -2).Select
End If
Loop

Many thanks

 

[Adam]

Sorry I put C in the original e-mail but I meant E

Column A is code for that person, B is Surname, C is 1st name, D has "Total"
enterred and E is where i would need the formula/count

cheers

 

[john]

Adam,
this may do what you want:


Sub AddTotals()
Dim ws1 As Worksheet
Dim rn As Long
Dim counta As Long

'name of worksheet where data stored
'change as required

Set ws1 = Worksheets("Sheet1")

'start search from row 5
rn = 5

'row marker used to create
'counta formula
counta = rn

With ws1

Do Until .Cells(rn, 1).Value = ""

If .Cells(rn + 1, 1) <> .Cells(rn, 1) Then

With .Cells(rn, 1)

.Offset(1, 0).EntireRow.Insert

.Offset(1, 1).Value = .Offset(0, 1).Value

.Offset(1, 2).Value = .Offset(0, 2).Value

.Offset(1, 3).Value = "TOTAL"

.Offset(1, 4).Formula = _
"=Counta(A" & counta & ":A" & rn & ")"

.Offset(1, 0).EntireRow.Font.ColorIndex = 3

End With

'skip blank cell
'created by row insert
rn = rn + 1

'set count start range
counta = rn + 1

End If

'increment row
rn = rn + 1

Loop

End With

End Sub

 

[Adam]

John

thanks for your time - i think i've just had a break through as the below
seems to be working for me. I will be stealing the best bit from yours
though to improve what i've got.

Many thanks

Range("A5").Select

Do Until Len(ActiveCell) = 0
If ActiveCell.Offset(1, 0) = ActiveCell Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(0, 1).Copy
ActiveCell.Offset(1, 1).PasteSpecial
ActiveCell.Offset(-1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(0, 1).Value = "TOTAL"
ActiveCell.Offset(0, 2).Value = "=Countif(A:A,'" &
ActiveCell.Offset(-1, -2).Value & "')"
ActiveCell.EntireRow.Font.ColorIndex = 3
ActiveCell.Offset(1, -2).Select
End If
Loop

Columns("E:E").Select
Selection.Replace What:="'", Replacement:=""""