How do I count occurrences of a pattern of data in Excel?

Question

I realized after manual scanning 90 records, that this was going to be painful and tedious unless I made use of automation.

I have this set of data, about 4000 records that occurs in a pattern that I want to track. The first column is the important one. I want to scan through the column and record in a NEW column how man times that number has occurred. Is it possible to do this programatically in Excel?

Note: I'm not just looking for a single pattern or single occurrence of a pattern.

Eg in this sample 313 occurs 1 time, 314 occurs 6 times, 315 occurs 2 times, etc.

At the end of the occurrences I want it to look like

--- Desired Output -------

313 1       343  1
314 1   344  
314 2   344 
314 3   344
314 4   344
314 5   344  
314 1   345  6
315 2   345  
315 1   346  2


-- Sample Data ------------------------------------
313 1   343
314 1   344
314 2   344
314 3   344
314 4   344
314 5   344
314 1   345
315 2   345
315 1   346
316 2   346
316 1   347
317 2   347
318 1   348
318 2   348
319 1   349
319 2   349
319 3   349  

5/23/13 The data is delimited by the spaces. It is not all in one cell. I don't know how to create a grid picture here. The leftmost cell is the one I want counted.

The desired output is the example of what I want. There are six occurrences of 314, I want the count summary cell to be compiled in the row of the last occurrence.

Answer 1

I backed up, slowed down and went to some basic programming principles, as slow as they feel at times.

1. Flowchart
2. Pseudocode
3. prototype
4. test
5. repeat 3 and 4 as needed.

I found that the following code did EXACTLY what I needed. I share it for any who follow.

Sub countFoo()
Dim startCell As Range
Dim preCell As Range
Dim counter As Integer
Dim startPoint As Range, endPoint As Range
Dim fileName As String, delimitingCharacter As String, SQLpre As String, SQLpost As String
Dim SQL As String
Dim outfile As Integer

fileName = "update_foo.sql"
SQLpre = "UPDATE foo SET foodata = "
SQLpost = " WHERE details = '"
outfile = FreeFile()
Open fileName For Output As outfile
counter = 1

Set startPoint = Cells(2, 4)
startPoint.Activate

Debug.Print "Start Point:" & startPoint.Address
Debug.Print startPoint.Value

Set startCell = ActiveCell
Set preCell = startCell.Offset(-1, 0)


Do While startCell.Value <> "END"

If (startCell.Value = preCell.Value) Then
  counter = counter + 1
  Set preCell = startCell
  Set startCell = startCell.Offset(1, 0)
ElseIf ((startCell.Value <> preCell.Value) Or (startCell.Value = "END")) Then
  startCell.Offset(-1, 3).Value = counter
  If counter > 1 Then
    startCell.Offset(-1, 0).Interior.Color = 5296274
    startCell.Offset(-1, 1).Interior.Color = 5296274
    startCell.Offset(-1, 2).Interior.Color = 5296274
    startCell.Offset(-1, 3).Font.Bold = True
    With startCell.Offset(-1, 3).Interior
      .Pattern = xlGray8
      .PatternColor = 65535
      .Color = 5296274
    End With
  End If
  SQL = SQLpre & counter & SQLpost & startCell.Offset(-1, 0).Value & "';"
  Print #outfile, SQL
  counter = 1
  Set preCell = startCell
  Set startCell = startCell.Offset(1, 0)
End If
Loop
Close #outfile
End Sub

Answer 2

If all you want to do is count the number of ocurrences of a certain numer in a certain range all you have to do is use COUNTIF(range,criteria)

where range is the cells where you want to check ( according to you it would be "A1:A4000") and criteria is the number you are loonking for, it can also be an ocrrence like ">55" where it counts how many cells the value is bigger than 55.

Hope it helps, Bruno

The code i mentioned in the comment:

CurrentRowA = 1
LastRowA = Range("A50000").End(xlUp).Row
Dim r As Range
While CurrentRowA <= LastRowA
    CurrentRowB = 1
    LastRowB = Range("B50000").End(xlUp).Row
    Do While CurrentRowB <= LastRowB
        If Cells(CurrentRowA, "A").Value = Cells(CurrentRowB, "B").Value Then
            Exit Do
        Else
        CurrentRowB = CurrentRowB + 1
        End If
    Loop
    If CurrentRowB > LastRowB Then
        Cells(CurrentRowB, "B").Value = Cells(CurrentRowA, "A").Value
        Set r = Range("A1", "A" & LastRowA)
        Cells(CurrentRowB, "C").Value = Application.CountIf(r, Cells(CurrentRowA, "A").Value)
    End If
    CurrentRowA = CurrentRowA + 1
Wend
LastRowB = Range("B50000").End(xlUp).Row
Range("B2", "C" & LastRowB).Cut
Range("B1").Select
ActiveSheet.Paste

If what i described in my latest comment is what you really want all you have to do is paste this formulas in B1 =COUNTIF($A$1:A1;A1) and drag it to the last cell or double click in that blac square on B1 bottomtight corner, then if the calcution is automatic it's done, if it's manual you have to click calculate now and it's done

Hope it helps, Bruno

Answer 3

Paste this in D1 and drag down.

=IF(A2<>A1,COUNTIF($A$1:$A$100000,A1),"")

Adjust the range as you need. This formula assumes that the first 3 digits are in there own cell.

If your sample data is all in one column then you will have to use a Sumproduct with a Left function in place of the countif. You can use the following Formula in this case, But if your sample data is in 3 columns definatly use my fast formula.

=IF(LEFT(A1,3)<>LEFT(A2,3),SUMPRODUCT(--(LEFT($A$1:$A$100000,3)=LEFT(A1,3))),"")

EDIT Based on your comments and answer I have made a full guide on using the countif method as VBA should ALWAYS be avoided if possible. You had issues because your sample data provided in your question did not contain headers/ Column Labels here is the fixed guide.

Starting with your 3 columns with headers I wqould create a named range on the column youd like the counts for to do this use built in Name Manager and click on new:

Then from this Set the Name to CountColumn and in the Formula use the following:

=OFFSET($A$2,0,0,COUNTA($A$2:$A$1000000),1)

Now using a modified version of my original answer type the following in cell D2 :

=IF(A3<>A2,COUNTIF(CountColumn,A2),"")

AS shown above this is IDENTICAL to what your original question Asked for in Desired Output .

Now to further this to get the highlights as your VBA Code looks to do I would use the following.

Go Back to the Name Manager, as we did for the CountColumn , and Create another new Named Range called Sums And then change all the A references to D like follows:

=OFFSET($D$2,0,0,COUNTA($D$2:$D$1000000),1)

And you Name Manager Should look like the following:

Now in the Name Box (top left box next to formula bar) type in the word Sums to select the entire sum area so we can format it:

Then ****while sums area is highlighted*** go to Conditional Formatting ~~> New Rule:

And use the built in No Blanks Function:

Then for the format Use Fill and the color you want, Based on your posted formula I used the Green Color:

Now you should be done and your Data should look as the picture below does:

Answer 4

The following assumes that your data is all in one column (eg: "315 1 344" is one cell)

It will look at sheet1 starting from A1, generate a list of unique cell values and count any duplicates. Once all the records have been checked, it outputs the results to sheet2.

Sub Main()
' this requires you to add a reference to "Microsoft Scripting Runtime" (usefull if you do not know the methods of scripting.dictionary)
'Dim Results As New Scripting.Dictionary
' the line does not require you to add any extra references (there is no code-completion, you must know the methods and their arguments)
Dim Results As Object: Set Results = CreateObject("Scripting.Dictionary")
Dim Data As Variant
Dim Key As Variant
Dim Source As Worksheet: Set Source = ThisWorkbook.Worksheets("Sheet1") ' the sheet where your data is
Dim Destination As Worksheet: Set Destination = ThisWorkbook.Worksheets("Sheet2") ' where the results will be put
Dim Row As Long: Row = 1 ' the row number to start from
Dim Item As String
Data = Source.UsedRange.Value2
' iterate over the data
Do
    Item = Data(Row, 1)
    If Results.Exists(Item) = True Then
        Results(Item) = Results(Item) + 1
    Else
        Results(Item) = 1
    End If
    Row = Row + 1
Loop While Not Data(Row, 1) = ""
' display the output
Destination.Cells.Clear ' reset the worksheet
For Each Key In Results.Keys ' loop through the results
    Destination.Range("A1:B1").Insert xlShiftDown ' move the previous results down
    Destination.Cells(1, 1) = Key
    Destination.Cells(1, 2) = Results(Key)
Next Key

End Sub