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
instead of text.
Seems to work Ok for me, job complete. Farewell.