Do not count accounts without an active number in cell..

=HPSF=RMP

Board Regular
Joined
Jun 9, 2004
Messages
188
A1:200 = formula =T(Sheet2!A2).
Basically I am bringing the text over from Sheet 2 to Sheet 1 A1:A200

Below is the formula i'm using. Its automatically counts the Total entries and the Total duplicates. The problem i'm having is instead of counting the value that carries over from sheet 2 its counting the formula in sheet 1. I want it to only count the value that is carried over and ignore the formula in A1:A200 if the value isnt carried over and the cell is left blank.

Is this possible?

thanks



Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

' The items are in A1:A200
Set AllCells = Range("A1:A200")

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Update the labels on UserForm1
With UserForm1
.Label1.Caption = "Total Accounts: " & AllCells.Count
.Label2.Caption = "Unique Accounts: " & NoDupes.Count
End With

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ListBox1.AddItem Item
Next Item

' Show the UserForm
UserForm1.Show
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try this:

Code:
Sub RemoveDuplicates() 
   Dim AllCells As Range, Cell As Range 
   Dim TotCount as Long
   Dim NoDupes As New Collection 
   Dim i As Integer, j As Integer 
   Dim Swap1, Swap2, Item 

' The items are in A1:A200 
   Set AllCells = Range("A1:A200") 

' The next statement ignores the error caused 
' by attempting to add a duplicate key to the collection. 
' The duplicate is not added - which is just what we want! 
   On Error Resume Next 
   For Each Cell In AllCells 
      If Cell.Value <> "" Then
         NoDupes.Add Cell.Value, CStr(Cell.Value) 
' Note: the 2nd argument (key) for the Add method must be a string 
         TotCount = TotCount + 1
      End If
   Next Cell 

' Resume normal error handling 
   On Error GoTo 0 

' Update the labels on UserForm1 
   With UserForm1 
      .Label1.Caption = "Total Accounts: " & TotCount 
      .Label2.Caption = "Unique Accounts: " & NoDupes.Count 
   End With 

' Sort the collection (optional) 
   For i = 1 To NoDupes.Count - 1 
      For j = i + 1 To NoDupes.Count 
         If NoDupes(i) > NoDupes(j) Then 
            Swap1 = NoDupes(i) 
            Swap2 = NoDupes(j) 
            NoDupes.Add Swap1, before:=j 
            NoDupes.Add Swap2, before:=i 
            NoDupes.Remove i + 1 
            NoDupes.Remove j + 1 
         End If 
      Next j 
   Next i 

' Add the sorted, non-duplicated items to a ListBox 
   For Each Item In NoDupes 
      UserForm1.ListBox1.AddItem Item 
   Next Item 

' Show the UserForm 
   UserForm1.Show 
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,023
Messages
5,834,996
Members
430,331
Latest member
Syed Yasir Hannan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top