Request = I need a macro to remove doubles with 4 different digits .

jack

Member
Request = I need a macro to remove doubles with 4 different digits
Example
12 25 = yes
02 45 = remove or delete has 4 different digits 0,2,4,5
* The list has more than 4 thousand formations
Other
02 40 = yes
 

Cartref45

Member
Hi Jack I'm only a novice at Excel but try this

I’m not much good at macros but you can get what you want by using formulas.
The first sheet I convert the pairs into (General Format) and then into single digits and use a formula to get how many distinct digits there are.
Then I filter them to get all but 4 distinct digits.
I copy them to another sheet (sheet2)
I then copy Pairs 1&2 to sheet 3 where I convert them back into 2 digit pairs, Custom Format “00”.
You have 1514 pairs left
There are probably easier ways to do this but this might help

http://www.mediafire.com/file/edyem1j4i0wtnk1/File+for+Jack.xlsx

Cartref
 

Frank

Member
Option Explicit

Option Base 1
Sub Removediffs()

Dim r, i, count As Integer
Dim a, b, c, d, mystring As String
Dim flag As Boolean
Range("a1").Select
r = Cells(Rows.count, 1).End(xlUp).Row 'get how many results

ReDim combins(r) As String
For i = 1 To r
combins(i) = ""
Next
count = 0

For i = 0 To r

flag = True
mystring = Format(ActiveCell.Offset(i, 0), "00") & " " & Format(ActiveCell.Offset(i, 1), "00")
a = Left(mystring, 1)
b = Mid(mystring, 2, 1)
c = Mid(mystring, 4, 1)
d = Right(mystring, 1)


If a = b Then flag = False
If b = c Then flag = False
If c = d Then flag = False
If a = c Then flag = False
If a = d Then flag = False
If b = d Then flag = False

If flag = False Then
count = count + 1
combins(count) = mystring
flag = True
End If

Next

' output the results
Range("D1:d10000").ClearContents
Range("D1").Select

For i = 1 To count
ActiveCell.Offset(i - 1, 0) = combins(i)
Next

MsgBox ("From " & r & " results " & count & " pairs remain")
End Sub

' end of macro .......................................................

1. If you already have an Option Explicit at the top of your macro sheet, you dont need another so ignore this one.
2. Assumes you want results in column D
3. Assumes you wanted that space between pair 1 and pair 2 in col D.
4. Had to use a lower case d in this forum ( clearcontents line) because it replaced my text with a silly :D instead of text.

Seems to work Ok for me, job complete. Farewell.
 

Sidebar

Top