The leading zero in the numbers was causing the problem.


Sub get_unique()

Dim FNum As String

Sh1RowCount = 1
Sh2RowCount = 1
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount).Text < ""
FNum = Left(.Range("A" & Sh1RowCount), 7)
With Sheets("Sheet2")
Set c = .Columns("A:A").Find(what:=FNum, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & Sh2RowCount).NumberFormat = "@"
.Range("A" & Sh2RowCount) = FNum
.Range("B" & Sh2RowCount) = 1
Sh2RowCount = Sh2RowCount + 1
Else

.Range("B" & c.Row) = .Range("B" & c.Row) + 1
End If
End With

Sh1RowCount = Sh1RowCount + 1
Loop
End With

End Sub

"Sinner" wrote:

On Mar 19, 3:41 pm, Joel wrote:
Sub get_unique()

Sh1RowCount = 1
Sh2RowCount = 1
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount) < ""
FNum = Left(.Range("A" & Sh1RowCount), 7)
With Sheets("Sheet2")
Set c = .Columns("A:A").Find(what:=FNum, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & Sh2RowCount) = FNum
.Range("B" & Sh2RowCount) = 1
Sh2RowCount = Sh2RowCount + 1
Else
.Range("B" & c.Row) = .Range("B" & c.Row) + 1
End If
End With

Sh1RowCount = Sh1RowCount + 1
Loop
End With

End Sub



"Sinner" wrote:
Hi,

I have the following list.

08459087671
08459087673
08465228672
08429087671
08429087571
08454287667
08454287657
-----------------------------------
Would like to calculate the following i.e. the formula or VB code
should first list items based on first 7 characters uniqueness & then
the quanity count.

Result:
-----------------------------------
Items Qty
0845908 2
0846522 1
0842908 2
0845428 2- Hide quoted text -

- Show quoted text -

Joel it's working only if I set cell formatting of columnA of sheet1 &
sheet2 as text.
Can you incorporate same in the code?
Secondly I would like the item list to be in ascending order.

Thx.