Count rows and insert formula using row counts in VBA

[midoop]

Hello All,

I have a spreadsheet with data about what information in a database has been reviewed or not (data is reviewed on a “page” by “page” basis, per subject).</SPAN>
The data looks something like this:</SPAN>

SITE #</SPAN>	SUBJECT #</SPAN>	VISIT NAME</SPAN>	VISIT DATE</SPAN>	PAGE NAME</SPAN>	PAGE STATUS</SPAN>	REVIEWED?</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Hematology</SPAN>	Monitored</SPAN>	Yes</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Chemistry</SPAN>	Monitored</SPAN>	No</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Vital Signs</SPAN>	Monitored</SPAN>	Yes</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Eligibility</SPAN>	Complete</SPAN>	No</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Disease History</SPAN>	Complete</SPAN>	Yes</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Liver Function</SPAN>	Complete</SPAN>	Yes</SPAN>

<TBODY>
</TBODY>

The number of rows per subject varies as a function of number of pages that have data in them and is therefore dynamic.</SPAN>
I need to provide some metrics about how many pages per subject have been reviewed and this information needs to be presented in percent (%) format.</SPAN>
So for a given subject, all the rows will equal total number of rows (totrows) and all the rows with YES in column 7 will equal number of reviewed rows (revrows). This will make my formula look like:</SPAN>
Percent of reviewed per subject = (revrows/totrows)*100</SPAN>
And I want this formula result to be displayed in the cell (blank row, column 7), so that my data now looks like:</SPAN>

SITE #</SPAN>	SUBJECT #</SPAN>	VISIT NAME</SPAN>	VISIT DATE</SPAN>	PAGE NAME</SPAN>	PAGE STATUS</SPAN>	REVIEWED?</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Hematology</SPAN>	Monitored</SPAN>	Yes</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Chemistry</SPAN>	Monitored</SPAN>	No</SPAN>
1001</SPAN>	1001008</SPAN>	End of Study</SPAN>	06/15/2012</SPAN>	Vital Signs</SPAN>	Monitored</SPAN>	Yes</SPAN>
					% Reviewed</SPAN>	67%</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Eligibility</SPAN>	Complete</SPAN>	No</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Disease History</SPAN>	Complete</SPAN>	Yes</SPAN>
1001</SPAN>	1001009</SPAN>	Screening</SPAN>	07/02/2013</SPAN>	Liver Function</SPAN>	Complete</SPAN>	Yes</SPAN>
					% Reviewed</SPAN>	67%</SPAN>

<TBODY>
</TBODY>

I am not sure where or how to start writing this sort of code, so I would appreciate help or if someone could point me in the right direction. Thanks!</SPAN>

 

[Chris Mack]

Hi

This is working for me:

Sub Insert_Subtotals()
    Dim cell As Range
    n = Range("B" & Rows.Count).End(xlUp).Row
    For r = n To 3 Step -1
        If Cells(r, 2).Value <> Cells(r - 1, 2).Value Then
            Rows(r & ":" & r).INSERT Shift:=xlDown
        End If
    Next r
    n = Range("B" & Rows.Count).End(xlUp).Row + 1
    For Each cell In Range("G2:G" & n)
        If cell.Value = "" Then
            k = Application.WorksheetFunction.CountIf(Range("B2:B" & n), Range("B" & cell.Row - 1))
            cell.Formula = "=COUNTIF(G" & cell.Row - k & ":G" & cell.Row - 1 & ",""Y"")/" & k & ""
            cell.NumberFormat = "0%"
            cell.Offset(0, -1).Value = "% Reviewed"
        End If
    Next cell
End Sub

Test in a practice workbook first.

Hope this helps,

Chris.

 

[midoop]

It is not working for me. I get a run-time error 1004 (Application defined or object defined error) which highlights the following line in debug mode:

cell.Formula = "=COUNTIF(G" & cell.Row - k & ":G" & cell.Row - 1 & ",""Y"")/" & k & ""

Also, for the one value that was produced, it output that value in G2, not G, blank row.

 

[Chris Mack]

Are the gaps already in your data? I assumed they weren't.

If they are, remove lines 3-8 from the macro.

Hope this helps,

Chris.

 

[hayru]

Hi Chris,
Can you help me with a similar problem in VBA.
In sheet1 of a workbook I have core data existing out of > 100,000 rows and 219 Columns. What I'm looking for is a VBA code that looks in Colum X and inserts a blank row after each change of value. The sheet has been sorted on Colum X. I.e. the first 10,000 rows have the same value in Colum X, row 10,001 has a different value in this Colum and therefore the Macro need to insert a blank row after row 10,000 and should continue with the same from row 10,001 and further until the end. Is this possible in VBA? Best regards and thank you. Hayru

 

[Chris Mack]

Sub Insert_Rows()
 For r = Range("X" & Rows.Count).End(Xlup).Row to 2 Step -1
 If Cells(r, 24).Value <> Cells(r - 1, 24) Then
 Rows(r & ":" & r).Insert
 End If
 Next r
End Sub

 

[hayru]

Thanks Chris, is appreciated. I assume that I have to replace the X in your code with the actual Colum of my spreadsheet?

 

[hayru]

Hi Chris, sorry code did not work. new rows were only added beneath row 1. What did I do wrong?