Performing a cell-specific action in a "do until" loop

[blackd77]

Hello. I have a macro that locates the first new value in a sequence of values in a row, and inserts a row at that point.


Sub Macro1()
Dim i As Long
i = 2
Do Until Cells(i, 1) = ""
If Cells(i, 1) <> Cells(i - 1, 1) Then
Rows(i).Insert
i = i + 1
End If
i = i + 1
Loop
End Sub

What I'd like to do is to have this macro perform another action, such as performing a "counta" of the totals of each value. For instance, if the contents of the
rows were as follows:

Alpha
Alpha
Alpha
Beta
Beta
Beta
Gamma
Gamma
Epsilon
Epsilon
Tau
Tau
Tau

...the macro would return 3 for Alpha, 3 for Beta, 2 for Gamma, 2 for Epsilon, and 3 for Tau.

I'd also be open to other suggestions, such as using the subtotal function...but I would like to see this specific code described. My attempts to date result in errors. For instance, if I substitute the expression:

=subtotal(9,d1:d3) [where that cell range has appropriate values] my script errors out. If such a formula (which works okay in a spreadsheet) needs to be altered in order to work within a script, what would the alteration consist of? Are there general rules which one can apply to such a scenario?

Thanks in advance!




Dan

[Ken Puls]

Hi Dan, and Welcome to VBAX!

Give this a shot. Not pretty, but it works:


Sub Macro1()
Dim i As Long, sFormulaStart As String, lBailout As Long
i = 2
sFormulaStart = "$A$1"
Do
If Cells(i, 1) <> Cells(i - 1, 1) Then
Rows(i).Insert
Intersect(Rows(i), Columns(1)).Formula = _
"=counta(" & Intersect(Rows(i), Columns(1)).Offset(-1, 0).Address & _
":" & sFormulaStart & ")"
i = i + 1
sFormulaStart = Intersect(Rows(i), Columns(1)).Address
End If
i = i + 1
If Cells(i, 1) = "" Then lBailout = lBailout + 1
Loop Until lBailout > 1
End Sub

[gsouza]

Put this someplace in your code.


Range("t1").Select 'or where ever you want
ActiveCell.FormulaR1C1 = "=COUNTIF(R[6]C[4]:R[15]C[4],""betta"")"

then add this section of code to other cells with the other formulas
I think that is what you want

Forget it this is not what you want.

[blackd77]

Ken,

That worked perfect! Thanks.

GSouza,

I'll see what that does. Thanks!




Dan