ExcelBanter - Unique Values in a list

The below code should do what you are looking for and a little more,
Hope this helps,
Felix

Sub AgregateIDs()
Dim MySheet As Worksheet
Dim EndArray As Double
Dim MyArray
Dim i, ii, x1 As String, x2 As String, crit1, crit2, ActSheet, ActCol, GoFor
'Find the maximum number of combinations
ActSheet = MsgBox("Active Sheet only(yes)? or entire Workbook (no) ?",
vbYesNo)
ActCol = MsgBox("Selected Column only?", vbYesNo)

For Each MySheet In ActiveWorkbook.Worksheets
If ActSheet = vbYes Then
If MySheet.Name = ActiveSheet.Name Then
EndArray = EndArray + MySheet.UsedRange.Rows.Count
End If
Else
EndArray = EndArray + MySheet.UsedRange.Rows.Count
End If
Next

'Create an Array of the maximum size
ReDim MyArray(EndArray, 2)
If ActCol = vbYes Then
crit1 = ActiveCell.Column
crit2 = ActiveCell.Column
Else
crit1 = CDbl(InputBox("Enter column number of the column with the first
criteria", "Criteria 1"))
crit2 = CDbl(InputBox("Enter column number of the column with the second
criteria", "Criteria 2"))
End If

'Fill the array with unique pairs
For Each MySheet In ActiveWorkbook.Worksheets
If ActSheet = vbYes Then
If MySheet.Name = ActiveSheet.Name Then
GoFor = True
Else
GoFor = False
End If
Else
GoFor = True
End If
If GoFor = True Then
For i = 1 To MySheet.UsedRange.Rows.Count
x1 = CStr(MySheet.Cells(i, crit1).Value)
x2 = CStr(MySheet.Cells(i, crit2).Value)
For ii = 0 To EndArray
If x1 = MyArray(ii, 0) Then
If x2 = MyArray(ii, 1) Then
MyArray(ii, 2) = MyArray(ii, 2) + 1
Exit For
End If
ElseIf MyArray(ii, 0) = Empty Then
MyArray(ii, 0) = x1
MyArray(ii, 1) = x2
MyArray(ii, 2) = MyArray(ii, 2) + 1
Exit For
End If
Next
Next
End If
Next

'Add a new sheet
Sheets.Add

'Fill the sheet with unique ID Name combinations
For i = 0 To EndArray
With ActiveSheet
.Cells(i + 1, 1).Value = "'" & CStr(MyArray(i, 0))
If ActCol = vbNo Then
.Cells(i + 1, 2).Value = "'" & CStr(MyArray(i, 1))
.Cells(i + 1, 3).Value = MyArray(i, 2)
Else
.Cells(i + 1, 2).Value = MyArray(i, 2)
End If
End With
If MyArray(i, 0) = Empty Then Exit For
Next

MsgBox CStr(i) + " unique records or combination of records found"

End Sub

"PGalla06" wrote:

Does anyone know how to write code that will count the unique values in
a list?

--
PGalla06
------------------------------------------------------------------------
PGalla06's Profile: http://www.excelforum.com/member.php...o&userid=24260
View this thread: http://www.excelforum.com/showthread...hreadid=469178