Table of instances

[Codman]

Hi,

I'm new at vba and have a brain teaser with a table in Excel. I have a table as shown below and assuming that each row is an instance with up to three variable each, (Col 1 being the index number), I need to identify the number of identical instances in total. The table will have a maximum number of 30 rows, but I don't know where to start! Can anyone point me in the right direction?

Col1 Col2 Col3 Col4
1 5 With Red
2 5 With Red
3 5 Without Red
4 5 Without Blue
5 7 Without Red
6 7 Without Blue
7 8 With Red
8 8 With Red
9 8 Without Blue
10 8 Without Red


PDF

 

[Zathras]

Record a macro using Data/Filter/Advanced Filter... and tick the box that says Unique records only.

You may need to add column headings first. (Unless "Col2","Col3", etc. are your column headings.)

Only select the three columns with the data, do not include "Col1".

 

[Codman]

Great I'll give that a go and let you know

PDF

 

[Codman]

Hmm, It worked in terms of showing unique items, but I need to know how many instances of each item there were. I.e if I had 4 instances of '5, with, red' I need to record how many times this occured. I've tried count, countA, row etc but none of these help. Do you have anything else up your sleeve?

PDF

 

[Zathras]

A "qick and dirty" way would be to use a Pivot Table (Data/Pivot Table Report...) Drag Col2, Col3 and Col4 into the "ROW" section, Drag Col1 into the "DATA" section, double click to change the math from Sum to Count.

If that's too messy, you can create a "Col5" by concatenating colums 2, 3 and 4 together (e.g. [blue]

   E2: =B2&" "&C2&" "&D2

[/color]
and just put Col5 in the "ROW" section. (And count Col1 in the "DATA" section.)

If you really need/want a VBA solution, let me know and I can probably cobble something together to do it that way.

 

[Codman]

The pivot table works, but I'd really like to handle this via vba if possible. Any help in showing me the way to go would be good.

Thanks

Pete

 

[Zathras]

You can use a pivot table with VBA, then copy the results to wherever you want. Delete the pivot table when finished. You can use the macro recorder to capture all of the steps in code and then tweak the code to fit your situation.

Of course, it could be done without a pivot table, but why not take the easy way out?

You never actually indicated how you wanted the results to appear. Do you want the pivot-table look? Or do you want to see a number next to the data indicating how many instances there are? I.e., something like this:

Col1  Col2  Col3      Col4   Col5
 1     5    With      Red     2
 2     5    With      Red     2
 3     5    Without   Red     1
 4     5    Without   Blue    1
 5     7    Without   Red     1
 6     7    Without   Blue    1
 7     8    With      Red     2
 8     8    With      Red     2
 9     8    Without   Blue    1
10     8    Without   Red     1

It helps to know where the target is before starting to shoot.

 

[Codman]

Hi Zanthras,

The look of the table should be as a list of unique itmes with a quantity column showing the number of instances as below.

Col1 Col2 Col3 Col4
Qty Value Type Color
2 5 With Red
1 5 Without Red

Ans so on...

Thanks for your help


Pete

 

[Zathras]

Here is a routine that does what you asked for:
[blue]

Option Explicit

Sub EnumerateMyTable()
  EnumerateInstances Range("B1:D11"), Range("G1")
End Sub

Sub EnumerateInstances(InputTable As Range, OutputTable As Range)

[green]

' All columns from the InputTable are treated as
' one concatenated string and the number of instances
' is counted.
'
' The results are put in the Output Table with the
' instance count in the left-hand column and the
' detail data from the InputTable is repeated.
'
' The upper left-hand corner of the OutputTable range
' is used to position the output.  A single cell is all
' that is really necessary.

[/color]

Dim oUpperLeft As Range
Dim c As Range
Dim oResults As Range
Dim nRow As Long

[green]

  ' Define and clear output area.

[/color]

  Set oUpperLeft = OutputTable.Cells(1, 1)
  With InputTable
    Set c = oUpperLeft.Offset(.Rows.Count - 1, .Columns.Count)
  End With
  Set oResults = Range(oUpperLeft, c)
  Union(OutputTable, oResults).Clear

[green]

  ' Copy headings to output area

[/color]

  oUpperLeft.Value = "Qty"
  InputTable.Rows(1).Copy oUpperLeft.Offset(0, 1)

[green]

  ' Copy unique rows from input to output.
  ' If already there, increment count in first column.

[/color]

  For Each c In Intersect(InputTable, InputTable.Columns(1))

[green]

    ' Ignore header row

[/color]

    If c.Row <> InputTable.Row Then
      nRow = FindARow(c, oResults)
      If nRow > 0 Then
        oResults.Cells(nRow, 1).Value = oResults.Cells(nRow, 1).Value + 1
      Else
        nRow = FindNextRow(oResults)
        oResults.Cells(nRow, 1).Value = 1
        Intersect(InputTable, c.EntireRow).Copy oResults.Cells(nRow, 2)
      End If
    End If
  Next c

[green]

  ' Free memory

[/color]

  Set oUpperLeft = Nothing
  Set c = Nothing
  Set oResults = Nothing
End Sub

Private Function FindARow(RefCell As Range, SearchTable As Range) As Long

[green]

' Note: RefCell corresponds to 2nd column of Search Table
'       other columns follow in order

[/color]

Dim bSearching As Boolean
Dim bMatchFound As Boolean
Dim i As Integer
Dim nRow As Long

[green]

  ' Start with row 2 - ignore headings

[/color]

  nRow = 2
  bSearching = True
  While bSearching
    bMatchFound = True
    For i = 1 To SearchTable.Columns.Count - 1
      If RefCell.Cells(1, i) <> SearchTable.Cells(nRow, i + 1) Then
        bMatchFound = False
        Exit For
      End If
    Next i
    If bMatchFound Then
      bSearching = False
      FindARow = nRow
    Else
      nRow = nRow + 1
      If IsEmpty(SearchTable.Cells(nRow, 1)) Then
        bSearching = False
        FindARow = -1
      End If
    End If
  Wend
End Function

Private Function FindNextRow(SearchTable As Range) As Long
  If IsEmpty(SearchTable.Cells(2, 1)) Then
    FindNextRow = 2
  Else
    FindNextRow = SearchTable.Cells(1, 1).End(xlDown).Row + 1
  End If
End Function

[/color]

 

[MeGustaXL]

Hi Folks!

I'm sorry I can't really add anything that helps Pete, but I've just got to know how Zathras gets his table formatted so neatly! Whenever I post data like that it looks like Pete's table in the first box, ie all staggerdy-zig-zaggy.

BTW, I needed to do something similar and went the Pivot Table way; worked just fine but looked too industrial - maybe I'll try Zathras's code next time



Chris

Varium et mutabile semper Excel

 

[Codman]

Hi Zanthras,

Good Job! it worked fine within my sheet. I had to change the range and criteria position, but does what I need.

Keep on smiling
Pete

 

[Codman]

Hi Zathras,

A couple of general questions regarding the code. It works just great, but I'd like to lose the last row reporting the Blanks. I've tried playing with the code but no joy. Could you identify the correct line for me?

Pete

 

[Zathras]

Pete, I don't understand. What Blanks? There were no Blanks in the data you specified.

Without knowing exactly what you have, you could try changing the line that reads
[blue]

  If c.Row <> InputTable.Row Then

[/color]
to read
[blue]

  If c.Row <> InputTable.Row And Not IsEmpty(c) Then

[/color]
That might be what you are looking for.

 

[Codman]

Zathras,

This worked fine. I was trying to remove the last Qty value hanging around in the breeze, remainder of the number of rows in my case. Thanks again buddy.


Pete