autofiltering question and possible logic question

B

bst

my problem:
i have a simple sheet with a list of names and some other data, what i
would like to do is count the occurance of each unique name and then in
another sheet print the name and the number of times it occurs. i want
to be able to open the sheet, and run the macro with no user involvment.
sheet1 sheet2
abe abe 4
abe bill 2
abe
abe
bill
bill

my first thought was to use the autofilter method. i thought of this
because if i do it manully excel allows me to choose from the drop down
menu what i would like to filter the sheet by and it lists each unique
name. after exploring the autofilter, filters, and filter help vba notes
i can not find a way to extract the criteria from that 'magical' excel
list. is this possible and if so how would you go about that? the names
are unknown and can change from day to day, so i can't keep a list of
names and use it as criteria 1 if i were to call the autofilter method.

my second though was to create a dynamic array and read each name from
the sheet and add it to the array only if it is unique. then apply the
autofilter method with array as criteria1 and then count the result:

'the first name is of course going to be unique
totalnames = 1
x = 1
uniquename = true
names(1) = cell(1,1).value
rowctr = 2
while not end of sheet
for x = 1 to totalnames
if names(x) = cell(rowctr,1).value
uniquename = false
x = totalnames + 1 ' end loop
else
uniquename = true
end if
next x
if uniquename
totalnames++
names(totalnames) = (rowctr,1).value
end if
rowctr++
end loop

assuming the above logic is correct (not the syntax) i would have an
array with the unique names.

can i set the criteria1 field for autofilter using a variable?
range.autofilter field:= 1 criteria1:=names(x)? if so from that point i
can just count the visible rows (usedranged.rows.count)?
or add a new column with the number 1 beside each name and use the sumif
function? sumif(range, names(x), range2)?

i'm pretty sure that the second method would work, but i'm new to vba
and am trying to learn new ways of manipulating the data. it seems to be
that i can skip a lot if i can get the criteria the excel displays in
that drop down menu.

any ideas or suggestions for this project is appreciated. it will be a
great time saver.

TIA

bst
 
J

Joel

first, If you can do something manually then turn On Record Macro (menu tools
- Macro - Record Macro) and then modify the code as required in you r own
macro. I do it all the time because I can't remember every syntax in VBA.

Use advance filter

Sheets("Sheet1").Columns("A").AdvancedFilter _
Action:=xlFilterInPlace, _
Unique:=True
Sheets("Sheet1").Columns("A").Copy _
Destination:=Sheets("sheet2").Columns("A")
 
B

bst

first, If you can do something manually then turn On Record Macro
(menu tools - Macro - Record Macro) and then modify the code as
required in you r own macro. I do it all the time because I can't
remember every syntax in VBA.

Use advance filter

Sheets("Sheet1").Columns("A").AdvancedFilter _
Action:=xlFilterInPlace, _
Unique:=True
Sheets("Sheet1").Columns("A").Copy _
Destination:=Sheets("sheet2").Columns("A")
<snip>
thanks for your advice. i had of course tried recording the macro (with
normal autofilter), but if you do it yourself, you will see the results
were not helpful at all, since the macro plugs in the name i selected,
and the point was to see if i could get that list of names from some
object property or method.

i had went with the second method and the code below does the trick, all
that is needed is to put in a check for approaching the upperbound of my
array and a resize if needed. it captures the uniquename and counts how
many times each name occurs:

For rowctr = 3 To totalrows
For x = 1 To totalnames
If names(x) = Cells(rowctr, 1).Value Then
uniquename = False
namesnumber(x) = namesnumber(x) + 1
x = totalnames + 1 ' end loop
Else
uniquename = True
End If
Next x
If uniquename Then
totalnames = totalnames + 1
names(totalnames) = Cells(rowctr, 1).Value
namesnumber(totalnames) = namesnumber(totalnames) + 1
End If
Next rowctr

i will attempt it with the advanced filter, but i do not believe that
will do the trick. i may have asked too many questions in the original
post because i'm not sure if you understood exactly what i was asking. i
will attempt to be more clear in the future.

thanks
bst


conversation
of
the flow
very hard to understand
it makes it
toppost
please dont
P.S.
 
J

Joel

You shouldn't modify thE for Counter. Use Exit for to end the loop or for a
dO LOOP USE EXIT DO.
 
P

Phillip

my problem:
i have a simple sheet with a list of names and some other data, what i
would like to do is count the occurance of each unique name and then in
another sheet print the name and the number of times it occurs. i want
to be able to open the sheet, and run the macro with no user involvment.
sheet1   sheet2
abe      abe    4
abe      bill   2
abe
abe
bill
bill

my first thought was to use the autofilter method. i thought of this
because if i do it manully excel allows me to choose from the drop down
menu what i would like to filter the sheet by and it lists each unique
name. after exploring the autofilter, filters, and filter help vba notes
i can not find a way to extract the criteria from that 'magical' excel
list. is this possible and if so how would you go about that? the names
are unknown and can change from day to day, so i can't keep a list of
names and use it as criteria 1 if i were to call the autofilter method.

my second though was to create a dynamic array and read each name from
the sheet and add it to the array only if it is unique. then apply the
autofilter method with array as criteria1 and then count the result:

'the first name is of course going to be unique
totalnames = 1
x = 1
uniquename = true
names(1) = cell(1,1).value
rowctr = 2
while not end of sheet
        for x = 1 to totalnames
                if names(x) = cell(rowctr,1).value
                        uniquename = false
                        x = totalnames + 1 ' endloop
                else
                        uniquename = true
                end if
        next x
        if uniquename
                totalnames++
                names(totalnames) = (rowctr,1).value
        end if
rowctr++
end loop

assuming the above logic is correct (not the syntax) i would have an
array with the unique names.

can i set the criteria1 field for autofilter using a variable?
range.autofilter field:= 1 criteria1:=names(x)? if so from that point i
can just count the visible rows (usedranged.rows.count)?
or add a new column with the number 1 beside each name and use the sumif
function? sumif(range, names(x), range2)?

i'm pretty sure that the second method would work, but i'm new to vba
and am trying to learn new ways of manipulating the data. it seems to be
that i can skip a lot if i can get the criteria the excel displays in
that drop down menu.

any ideas or suggestions for this project is appreciated. it will be a
great time saver.

TIA

bst

Phillip London UK


Alternative answer ,this works for me using collection and array
note that option Base must be set as shown in the code at the top of a
standard module.
This assumes your names are in column A starting in A1
Change Wdata reference to your existing sheet with names in it.
Change Rdata to the sheet where you want the summary

Option Base 1

Sub GetUniqueReport()
Dim knt As Long
Dim myrange As Range
Dim unirange As Range
Dim kntrange As Range
Dim uni As New Collection
Dim ArrUni() As Variant
Dim uknt As Long
Dim x As Long
Dim wdata As Worksheet
Dim rdata As Worksheet

Set wdata = Worksheets("Sheet2") 'change as required
Set rdata = Worksheets("Sheet3") 'change as required
wdata.Activate
Application.ScreenUpdating = False
Range("B:C").Insert 'temp dump of report
Set myrange = Range("A:A") 'assume names are in column A
knt = Application.WorksheetFunction.CountA(myrange)
If knt = 0 Then Exit Sub 'no names exit
Set myrange = wdata.Range("A1:A" & knt)
For Each cl In myrange
On Error Resume Next
uni.Add cl, cl
Next
uknt = uni.Count
ReDim ArrUni(uknt)
For x = 1 To uknt
ArrUni(x) = uni(x)
Next

Set unirange = Range("B1:B" & uknt)
unirange.Value = Application.Transpose(ArrUni)
Set kntrange = Range("C1:C" & uknt)
For x = 1 To uknt
kntrange(x) = Evaluate("=countif(" & myrange.Address & "," &
unirange.Cells(x).Address & ")")
Next
rdata.Range("A1:B" & uknt).Value = wdata.Range("B1:C" & uknt).Value
Range("B:C").Delete 'remove temp dump
rdata.Activate
Application.ScreenUpdating = True
End Sub
 
L

Lionel H

bst said:
my problem:
i have a simple sheet with a list of names and some other data, what i
would like to do is count the occurance of each unique name and then in
another sheet print the name and the number of times it occurs. i want
to be able to open the sheet, and run the macro with no user involvment.
sheet1 sheet2
abe abe 4
abe bill 2
abe
abe
bill
bill

my first thought was to use the autofilter method. i thought of this
because if i do it manully excel allows me to choose from the drop down
menu what i would like to filter the sheet by and it lists each unique
name. after exploring the autofilter, filters, and filter help vba notes
i can not find a way to extract the criteria from that 'magical' excel
list. is this possible and if so how would you go about that? the names
are unknown and can change from day to day, so i can't keep a list of
names and use it as criteria 1 if i were to call the autofilter method.

my second though was to create a dynamic array and read each name from
the sheet and add it to the array only if it is unique. then apply the
autofilter method with array as criteria1 and then count the result:

'the first name is of course going to be unique
totalnames = 1
x = 1
uniquename = true
names(1) = cell(1,1).value
rowctr = 2
while not end of sheet
for x = 1 to totalnames
if names(x) = cell(rowctr,1).value
uniquename = false
x = totalnames + 1 ' end loop
else
uniquename = true
end if
next x
if uniquename
totalnames++
names(totalnames) = (rowctr,1).value
end if
rowctr++
end loop

assuming the above logic is correct (not the syntax) i would have an
array with the unique names.

can i set the criteria1 field for autofilter using a variable?
range.autofilter field:= 1 criteria1:=names(x)? if so from that point i
can just count the visible rows (usedranged.rows.count)?
or add a new column with the number 1 beside each name and use the sumif
function? sumif(range, names(x), range2)?

i'm pretty sure that the second method would work, but i'm new to vba
and am trying to learn new ways of manipulating the data. it seems to be
that i can skip a lot if i can get the criteria the excel displays in
that drop down menu.

any ideas or suggestions for this project is appreciated. it will be a
great time saver.

TIA

bst
Why not use a pivot table?
Assuming all columns are labeled (in the example below I put your list in A2
to A7 and 'myData' in A1, 'otherData' in B1 with rubbish below) then the
following works and can be generalised to fit your requirements:

Sub CreatePivotDemo()
'
' CreatePivotDemo Macro
' Macro recorded 11/08/2008 by Lionel H
'

'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R7C2").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("myData")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("myData"), "Count of myData", xlCount
End Sub
 
D

Don Guillett

This will make a unique list of any items in col a and put in col F and then
count each item in F that is in A.

Sub makeuniquelistandcount()
Application.ScreenUpdating = False

mc = "a"
lr = Cells(rows.Count, mc).End(xlUp).Row
With Range("A1:A" & lr)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Copy Range("F1")
Application.CutCopyMode = False
ActiveSheet.ShowAllData
End With

flr = Cells(rows.Count, "f").End(xlUp).Row
For Each c In Range("f2:f" & flr)
c.Offset(, 1) = Application.CountIf(Range("a2:a31"), c)
Next c

Application.ScreenUpdating = True
End Sub
 
D

Don Guillett

Change
c.Offset(, 1) = Application.CountIf(Range("a2:a31"), c)
to
c.Offset(, 1) = Application.CountIf(Range("a2:a" & lr), c)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top