separate cracks without typing.

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Hello piter,

I added this macro to the worksheets Change Event. It will evaluate the values as type into the cells in columns "A:C". If there are no repeating numbers and the numbers contain only 2 digits then the numbers are output in the same row to column "E".

pasta das trincas ver 1.xlsm

Code:
Private Sub Worksheet_Change(ByVal Target As Range)


    Dim Cell    As Range
    Dim Digits  As Variant
    Dim j       As Integer
    Dim k       As Integer
    Dim n       As Integer
    Dim Repeats As Boolean
    Dim Rng     As Range
    Dim Text    As String
    
        If Target.Cells.Count > 1 Then Exit Sub
        If Intersect(Target, Range("A:C")) Is Nothing Then Exit Sub
        If Len(Target.Text) <> 2 Then Exit Sub
        If Not IsNumeric(Target) Then Exit Sub
        
        Set Rng = Range(Cells(Target.Row, "A"), Cells(Target.Row, "C"))
        
        ReDim Digits(9)
        
            For Each Cell In Rng
                n = Cell.Value
                j = n Mod 10
                k = n \ 10
                Digits(j) = Digits(j) + 1
                Digits(k) = Digits(k) + 1
            Next Cell
            
            For n = 0 To 9
                If Digits(n) > 1 Then Repeats = True
            Next n
            
        If Not Repeats Then
            For n = 1 To 3
                If Text = "" Then
                    Text = Format(Cells(Target.Row, n), "00")
                Else
                    Text = Text & "," & Format(Cells(Target.Row, n), "00")
                End If
            Next n
            Cells(Target.Row, "E") = Text
        End If
        
End Sub
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows
Hello and the others? Type = 04 28 37?
They're all cracks !!! Within the condition of not having repeated digits
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows
but the excluded cracks can have 3,4 double digits not only 2 you filter or separate in a list only the cracks with 6 different digits or separtete duplicates of digits
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

hello ROSS We have a problem, the macro is not doing it!
With six different digits
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Hello Piter,

It appears I misunderstood your request. Can you provide me a couple of before and after examples of how this should work?
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

hello,ROSS from the list given, you have to separate all the formations
with 6 different digits
10 26 38
08 14 36
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,526
Office Version
  1. 365
Platform
  1. Windows
.. from the list given, you have to separate all the formations
with 6 different digits
10 26 38
08 14 36
Try this in a copy of your workbook.

Code:
Sub piter()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim s As String, d As String
  Dim bFail As Boolean
  
  a = Range("A5", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  
  For i = 1 To UBound(a)
    s = Format(a(i, 1), "00") & "," & Format(a(i, 2), "00") & "," & Format(a(i, 3), "00")
    bFail = False
    For j = 2 To Len(s)
      d = Mid(s, j, 1)
      If d Like "#" Then
        If InStr(1, s, d) < j Then
          bFail = True
          Exit For
        End If
      End If
    Next j
    If Not bFail Then
      k = k + 1
      b(k, 1) = s
    End If
  Next i
  If k > 0 Then
    Range("E5").Resize(k).Value = b
  End If
End Sub
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows
yes, ok PETER, PERFECT,THANK YOU!
 

piter

Active Member
Joined
Jul 22, 2011
Messages
309
Office Version
  1. 2016
Platform
  1. Windows
Hello, Peter, using the same code
I have, a quadruple file of 850 thousand or more
Example
02 15 26 35
That is, using the same code to remove duplicates from the quadruples
 

Forum statistics

Threads
1,137,125
Messages
5,679,755
Members
419,855
Latest member
Eddier32

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