Code for unique Data Entries?

F

Faraz A. Qureshi

I have a macro that I seek to apply only on unique entries. How 2 achieve the
same. For instance what would be a sample code for:
1) Entering a data column; &
2) Result being message/alert box appearing as many times as there are
UNIQUE entries, like:
"There were 50 entries of A"
"There were 45 entries of B"
"There were 59 entries of C"
"There were 71 entries of D"

if there was a record set, as selected, with 229 records/rows, but with only
4 unique entries.
 
J

Jacob Skaria

Right click the sheet tab>View code and paste the below code...and try
entering data into Col A

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Count = 1 And Trim(Target.Text) <> "" Then
If WorksheetFunction.CountIf(Columns(Target.Column), Target.Text) > 1 Then
MsgBox WorksheetFunction.CountIf(Columns(Target.Column), Target.Text) & "
entries of '" & Target.Text & "'"
Target = ""
End If
End If
End If
End Sub

If this post helps click Yes
 
F

Faraz A. Qureshi

Sorry Jacob,

But the code is not working. Don't you think a loop should be used to
gather-up statistics pertaining to unique entries?
 
F

Faraz A. Qureshi

Another example is how to have filter be applied upon a data set but only the
times a unique entries are present?
 
J

Jacob Skaria

Paste the code and in Column A try entering duplicate values..

If this post helps click Yes
 
F

Faraz A. Qureshi

That is the main issue!

I don't seek to carry out an operation later on, but rather apply the same
on an existing data set.

For eample, with a data list in A:A how to have the same filtered out with
different criteria to extract the records pertaining to each of the unique
entry?
 
F

Faraz A. Qureshi

Thanx Bernd but it was just an example.

How to have a data filtered for each unique entry of a column?
 
J

Jacob Skaria

Insert a new module and paste the below code...Run Sub Macro and see...This
will work on the active sheet Col A from Row1....Try and feedback

Dim arrTemp As Variant
Sub Macro()
Dim lngRow As Long
Dim varData As Variant
ReDim arrTemp(0)
For lngRow = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & lngRow) <> varData Then
AddtoArray Trim(Range("A" & lngRow))
End If
varData = Range("A" & lngRow)
Next

For lngRow = 1 To UBound(arrTemp)
varData = WorksheetFunction.CountIf(Columns("A"), arrTemp(lngRow))
MsgBox "There were " & varData & " entries of " & arrTemp(lngRow)
Next
End Sub
Sub AddtoArray(varTemp As Variant)
Dim lngTemp As Long
For lngTemp = 1 To UBound(arrTemp)
If arrTemp(lngTemp) = varTemp Then Exit Sub
Next
ReDim Preserve arrTemp(UBound(arrTemp) + 1)
arrTemp(UBound(arrTemp)) = varTemp
End Sub

If this post helps click Yes
 

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