Count the number of cells with text below a number and output the result in separate columns

Hi<
I have a fairly straightforward problem - unfortunately, I am in a bit of a time crunch. The issue is that have one column of cells which contain either cells with only numbers or cells that are mostly text but may include a number at the beginning of the variable - the last character would always be text though.. I need to count the number of cells with text in them below each cell that contains a number and then write the count beside that cell with the number in it. For example here is my column:

So what I would like to end up with is a macro or vba routine that will output the following in a different columns nearby:

1111 1
2227 1
1313 3
1557 6
2223 5

This is just a sample - the actual column contains approximately 3400 cells with probably approx 2000 containing numbers with varying numbers of cells below each of them containing text (and perhaps starting with a number).

y dont you use pivot table ... its easy to use and will fix your problem example.xlsx

0

scurvylionAuthor Commented:

No i need the count of the cells with text under each each number. Your answer gives the count of cells under number 1111 as 20 when it is 1.

After determining that the count of cells under 111 is 1 then I need the count of cells with text under 2227 and then the count of cells with text under 1313 and so on.

see my example again.

0

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Sub CountCellsWithLetters() Dim myrow, mycolumn, lastrow, myreportrow, myreportcol, mynumber As Long Dim myarea, mycell, myprintnumber, myprintcount As Range Dim mycount As Integer myrow = ActiveCell.Row mycolumn = ActiveCell.Column myreportrow = myrow myreportcol = mycolumn + 1 lastrow = ActiveSheet.Cells(65536, myrow).End(xlUp).Row + 1 Set myarea = ActiveSheet.Range(Cells(myrow, mycolumn), Cells(lastrow, mycolumn)) For Each mycell In myarea If IsNumeric(mycell.Value) Then If mycount <> 0 Then myprintnumber.Value = mynumber myprintcount.Value = mycount myreportrow = myreportrow + 1 End If mynumber = mycell.Value mycount = 0 ElseIf mycell.Value Like "*[a-zA-Z]*" Then If mycount = 0 Then Set myprintnumber = ActiveSheet.Cells(myreportrow, myreportcol) Set myprintcount = ActiveSheet.Cells(myreportrow, myreportcol + 1) End If mycount = mycount + 1 End If NextEnd Sub

Assuming data in column A, cells A2:A22 for sample above, a fairly simple formula driven solution:

B2 =ISNUMBER(A2) Result will be TRUE or FALSE, Copy down as required.
C2 =IF(ISNUMBER(A2),A2,C1) Result will be copy of column A for new numbers or repeat of number above for text lines, copy down as required.
D2 =COUNTIF($C$2:$C$22,C2)-1 Result will count of cells matching C2, less 1 if you need to allow for first "title" row. Change range in COUNTIF(range,criteria) to allow for all cells.

Select range and activate AutoFilter, in column B select dropdwon and choose TRUE. Hide columns B & C if so required.

Thanks
Rob H

0

scurvylionAuthor Commented:

Excellent work - and very timely. Thanks again for your assisatnce.

0

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.