CODEWITHSUNDEEP
excelvba
quantum231
quantum231

Reputation: 2583

Filter duplicate values and count the occurances using Excel VBA

How to carry out this task in VBA?

Example, the following information is contained in a spreadsheet named fraca1 in Excel, note the letters A and F are the column names in Excel and not part of dataset.

A                   F
FRACA 012313        Correction 1
FRACA 012313        Correction 2
FRACA 012313        Investigation 1
FRACA 012313        Investigation 2
FRACA 012317        Investigation 1
FRACA 012317        Investigation 2
FRACA 012317        Investigation 3
FRACA 018593        Correction 1
FRACA 035586        Correction 1

I have data contained in several columns. I need to find 3 things.

  1. What are the unique FRACA numbers in column A.
  2. How many cells in column F contain the word "Correction" corresponding to each unique FRACA number.
  3. How many cells in column F contain the word "Investigation" corresponding to each unique FRACA number.

This information must then be put into a new spreadsheet in the same workbook. The resulting spreadsheet would look like this:

A               B                 C
FRACA No.       Correction No.    Investigation No.
FRACA 012313    2                 2
FRACA 012317    0                 3
FRACA 018593    1                 0
FRACA 035586    1                 0

Upvotes: 1

Views: 965

Answers (1)

learn2day
learn2day

Reputation: 1716

I hope this helps, it is for the first part of your question. You must have the Microsoft Scripting Runtime reference activated on VBA.

''''''''''''''''''
'1-What are the unique FRACA numbers in column A.
''''''''''''''''''
Application.Calculation = xlCalculationManual 'For faster running time
'Create the Scripting Dictionary
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Dim myFirstCol() As Variant
Dim i As Long
'Code Assumes data is in Sheet1 and needs to go to Sheet2 (code names)
arrLength = WorksheetFunction.CountA(Sheet1.Columns("A:A"))
ReDim myFirstCol(1 To arrLength)
'First read your input column
For i = 1 To arrLength
    myFirstCol(i) = Sheet1.Cells(i, 1)
Next i
'create the unique keys
For i = LBound(myFirstCol) To UBound(myFirstCol)
    d(myFirstCol(i)) = mySecondCol(i)
Next i
'Now write your keys to Sheet2
Dim v As Variant
i = 2
For Each v In d.Keys()
    Sheet2.Cells(i, 1) = v
    i = i + 1
Next v
Application.Calculation = xlCalculationAutomatic

For the rest of your problem it should be now easier having the unique values of FRACA solved. If I have some time I will complete the answer with the other 2 parts.

Upvotes: 2

Related Questions