If value occurs more than once then delete all of them

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

If a value in varData occurs more than once, then delete all same values in varData and list remaining values in column F.

Values as either Integers or text or both, if possible.

This code does not like the CountIf.

Thanks.
Howard


Sub LoneValueStay()
Dim varData As Variant
Dim i As Long

varData = Sheets("Sheet1").Range("A2:D15") '// Read in the data.

For i = LBound(varData) To UBound(varData)
If Application.WorksheetFunction.CountIf(varData(i, varData)) > 1 Then
varData(i) = ""
'varData(i).Delete
End If
Next i

'// Write result to sheet.
'Sheets("Sheet1").Range("F1").Resize(UBound(varData) - LBound(varData) + 1, 1) _
= varData
End Sub
 
Hi Howard,

Am Sun, 6 Jul 2014 21:18:22 -0700 (PDT) schrieb L. Howard:
If a value in varData occurs more than once, then delete all same values in varData and list remaining values in column F.

try:

Sub LoneValueStay2()
Dim varData() As Variant
Dim rngC As Range
Dim i As Long

With Sheets("Sheet1")
ReDim Preserve varData(65)
For Each rngC In .Range("A2:D15")
If WorksheetFunction.CountIf(.Range("A2:D15"), rngC) = 1
Then
varData(i) = rngC
i = i + 1
End If
Next

'// Write result to sheet.
.Range("F1").Resize(UBound(varData) + 1, 1) = _
Application.Transpose(varData)
End With
End Sub


Regards
Claus B.
 
Thanks Claus.

I can make the uR value work for the ReDim value, but can't figure how to get UsedRange instead of the hardcoded Range("A1:D144").

Sorry, I should have mentioned the range could vary.

Howard

Sub LoneValueStay2()
Dim varData() As Variant
Dim rngC As Range, uRng As Range
Dim i As Long, uR As Long

uR = Application.WorksheetFunction.CountA(Sheets("Sheet1").UsedRange)

With Sheets("Sheet1")
ReDim Preserve varData(uR)
For Each rngC In .Range("A1:D144")
If WorksheetFunction.CountIf(.Range("A1:D144"), rngC) = 1 Then
varData(i) = rngC
i = i + 1
End If
Next

'// Write result to sheet.

.Range("F1").Resize(UBound(varData) + 1, 1) = _
Application.Transpose(varData)
End With
End Sub
 
Hi Howard,

Am Sun, 6 Jul 2014 23:57:18 -0700 (PDT) schrieb L. Howard:
I can make the uR value work for the ReDim value, but can't figure how to get UsedRange instead of the hardcoded Range("A1:D144").

then try:

Sub LoneValueStay2()
Dim varData() As Variant
Dim rngC As Range
Dim i As Long

With Sheets("Sheet1")
ReDim Preserve varData(.UsedRange.Cells.Count)
For Each rngC In .UsedRange
If WorksheetFunction.CountIf(.UsedRange, rngC) = 1 Then
varData(i) = rngC
i = i + 1
End If
Next

'// Write result to sheet.
.Range("F1").Resize(UBound(varData) + 1, 1) = _
Application.Transpose(varData)
End With
End Sub


Regards
Claus B.
 
Hi Howard,

Am Mon, 7 Jul 2014 09:04:56 +0200 schrieb Claus Busch:
ReDim Preserve varData(.UsedRange.Cells.Count)

sorry, the array will only have the unique values and not all values in
UsedRange:

Sub LoneValueStay2()
Dim varData() As Variant
Dim rngC As Range
Dim i As Long

With Sheets("Sheet1")
For Each rngC In .UsedRange
If WorksheetFunction.CountIf(.UsedRange, rngC) = 1 Then
ReDim Preserve varData(i)
varData(i) = rngC
i = i + 1
End If
Next

'// Write result to sheet.
.Range("F1").Resize(UBound(varData) + 1, 1) = _
Application.Transpose(varData)
End With
End Sub


Regards
Claus B.
 
Hi Howard,



Am Mon, 7 Jul 2014 09:04:56 +0200 schrieb Claus Busch:






sorry, the array will only have the unique values and not all values in

UsedRange:



Sub LoneValueStay2()

Dim varData() As Variant

Dim rngC As Range

Dim i As Long



With Sheets("Sheet1")

For Each rngC In .UsedRange

If WorksheetFunction.CountIf(.UsedRange, rngC) = 1 Then

ReDim Preserve varData(i)

varData(i) = rngC

i = i + 1

End If

Next



'// Write result to sheet.

.Range("F1").Resize(UBound(varData) + 1, 1) = _

Application.Transpose(varData)

End With

End Sub





Regards

Claus B.


That's a winner, thanks.

Regards,
Howard
 
Given the number of requests we seem to get for finding/processing
matches/duplicates, the ways to handle this vary depending on the user's
scenario/criteria. Here's an example project that demos comparing 2 cols
of data and returning results 4 different ways. Look for
"FilterMatches.xls"...

https://app.box.com/s/23yqum8auvzx17h04u4f

--
-
Garry

Free Usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Given the number of requests we seem to get for finding/processing

matches/duplicates, the ways to handle this vary depending on the user's

scenario/criteria. Here's an example project that demos comparing 2 cols

of data and returning results 4 different ways. Look for

"FilterMatches.xls"...



https://app.box.com/s/23yqum8auvzx17h04u4f



--

-

Garry


Thanks, Garry.

That's quite a load!

I'll give that a study.

Howard
 
Yeah, it's a bit of a joint effort by a few others that helped out with
the coding so it was/is as optimized as possible. The file has 50K
values but in Excel12 and later it can setup 500K if you want to test
against larger amounts of data.

I didn't use any on sheet controls because I normally just run from the
macros dialog (Alt+F8) with macros for ThisWorkbook selected.

--
-
Garry

Free Usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top