Using COUNTU in VBA to delete certain values
 

Hi,

I'd like to count unique values in one column, grouped by a value in another
column. When the amount of unique values is lower than 6, all rows of that
group have to be deleted. My code - using COUNTU - looks like below.The
software however doesn't recognise COUNTU in VBA, COUNTU only seems to work
when I apply it in the worksheet itself. What could I do?


Sub CriteriaGroupsSixOrMore

'x is the amount of rows at the start of the calculation
'all rows are sorted alphabetically by column 3
x = 40000

Loop1:
y = 0

Loop2:
'There is no data to be analysed in the first four lines
If (x - (y + 1)) < 5 Then GoTo ExitCriteriaGroupsSixOrMore

'In column 3 is the grouping data.
'First the code tries to find out how large the groups are,
'because I'm only interested in groups larger than 5.
If Cells(x, 3).Value = Cells(x - (y + 1), 3).Value Then
y = y + 1
GoTo Loop2
Else
'Row (x-y) is the last row which is the same as (x).
If y < 5 Then
'Too few rows, they have to be deleted
GoTo DeleteFewRows

Else
'Right amount of rows, but are there at least 6 unique values in
column 7
'for this selection of rows?
CountUniques =
Application.WorksheetFunction.COUNTU(Worksheets(1) .Range(Cells(x - y, 7),
Cells(x, 7)))

If CountUniques < 6 Then
'Too few uniques, selection of rows has to be deleted
GoTo DeleteFewRows
Else
x = x - (y + 1)
End If
End If

GoTo Loop1

End If
End If

GoTo ExitCriteriaZesGroepen30SVOs

DeleteFewRows:
'The loop where the unwanted rows have to be deleted
For R = x To (x - y) Step -1
Rows(R).Delete Shift:=xlUp
Next
x = x - (y + 1)
GoTo Lus1


ExitCriteriaGroupsSixOrMo
Exit Sub

End Sub

Using COUNTU in VBA to delete certain values
 

In addition to the question: In the following example all rows about houses
would stay, while all rows about boats would be deleted.

Row 3 Row 7

House Lane
House Street
House Way
House Road
House Streetway
House Path
Boat Sea
Boat Sea
Boat Lake
Boat Sea
Boat Sea
Boat Sea
Boat Lake
Boat Lake

Using COUNTU in VBA to delete certain values
 

Help is no longer necessary, I solved the problem already.

I've changed COUNTU from a "public function" into a "function", and changed

CountUniques =
Application.WorksheetFunction.COUNTU(Worksheets(1) .Range(Cells(x - y, 7),
Cells(x, 7)))

into

CountUniques = COUNTU(Range(Cells(x - y, 7), Cells(x, 7)))


"Sietske" wrote:

Hi,

I'd like to count unique values in one column, grouped by a value in another
column. When the amount of unique values is lower than 6, all rows of that
group have to be deleted. My code - using COUNTU - looks like below.The
software however doesn't recognise COUNTU in VBA, COUNTU only seems to work
when I apply it in the worksheet itself. What could I do?


Sub CriteriaGroupsSixOrMore

'x is the amount of rows at the start of the calculation
'all rows are sorted alphabetically by column 3
x = 40000

Loop1:
y = 0

Loop2:
'There is no data to be analysed in the first four lines
If (x - (y + 1)) < 5 Then GoTo ExitCriteriaGroupsSixOrMore

'In column 3 is the grouping data.
'First the code tries to find out how large the groups are,
'because I'm only interested in groups larger than 5.
If Cells(x, 3).Value = Cells(x - (y + 1), 3).Value Then
y = y + 1
GoTo Loop2
Else
'Row (x-y) is the last row which is the same as (x).
If y < 5 Then
'Too few rows, they have to be deleted
GoTo DeleteFewRows

Else
'Right amount of rows, but are there at least 6 unique values in
column 7
'for this selection of rows?
CountUniques =
Application.WorksheetFunction.COUNTU(Worksheets(1) .Range(Cells(x - y, 7),
Cells(x, 7)))

If CountUniques < 6 Then
'Too few uniques, selection of rows has to be deleted
GoTo DeleteFewRows
Else
x = x - (y + 1)
End If
End If

GoTo Loop1

End If
End If

GoTo ExitCriteriaZesGroepen30SVOs

DeleteFewRows:
'The loop where the unwanted rows have to be deleted
For R = x To (x - y) Step -1
Rows(R).Delete Shift:=xlUp
Next
x = x - (y + 1)
GoTo Lus1


ExitCriteriaGroupsSixOrMo
Exit Sub

End Sub