vba compare arrays and remove exact matching arrays

[jacojvv]

Hi
I need help to create a <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vba</acronym> that will compare all arrays to each other ,example listed below they are sepperated by 1 blank line and to remove any of them that have all 30 identical nrs in identical positions.(in this example the firs and last array are identical)

30 16 32 36 15 23 13 17 45 9 34 41 27 31 33 39 25 37 43 3 6 19 28 5 12 22 10 26 24 18 37 9 25 13 28 19 22 43 17 16 31 41 33 36 34 32 12 18 45 10 26 15 6 27 39 3 23 5 30 24 17 39 31 19 37 34 9 15 36 12 10 16 43 25 26 3 33 22 45 28 30 13 5 24 18 6 23 41 32 27 12 43 34 33 18 5 6 26 15 9 28 30 17 41 22 45 36 16 25 37 10 27 13 19 3 23 24 31 39 32 30 16 32 36 15 23 13 17 45 9 34 41 27 31 33 39 25 37 43 3 6 19 28 5 12 22 10 26 24 18 <tbody> </tbody>

<tbody>
</tbody>

 

[wigi]

Hello,

Here's the skeleton of the code, you only stil need to compare the strings, the result of the concatenations.

Sub wigi()

    For Each ar In Columns(1).SpecialCells(2, 1).Areas
        
        For Each ar_2 In Columns(1).SpecialCells(2, 1).Areas
        
            If ar_2.Row > ar.Row Then
            
                Debug.Print ConCat("-", ar.Cells(1).CurrentRegion), ConCat("-", ar_2.Cells(1).CurrentRegion)
            
            End If
        
        Next
        
    Next


End Sub


Function ConCat(Delimiter As Variant, ParamArray CellRanges() As Variant) As String


    Dim Cell As Range, Area As Variant


    If IsMissing(Delimiter) Then Delimiter = ""


    For Each Area In CellRanges
        If TypeName(Area) = "Range" Then
            For Each Cell In Area
                If Len(Cell.Value) Then ConCat = ConCat & Delimiter & Cell.Value
            Next
        Else
            ConCat = ConCat & Delimiter & Area
        End If
    Next


    ConCat = Mid(ConCat, Len(Delimiter) + 1)
End Function

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG18Oct55
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] A           [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Str         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = UsedRange.SpecialCells(xlCellTypeConstants)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    Str = vbNullString
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] A [COLOR="Navy"]In[/COLOR] Dn
            Str = Str & A
        [COLOR="Navy"]Next[/COLOR] A
            [COLOR="Navy"]If[/COLOR] Not .Exists(Str) [COLOR="Navy"]Then[/COLOR]
                .Add Str, Nothing
            [COLOR="Navy"]Else[/COLOR]
               Dn.ClearContents
            [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[wigi]

Hi

I changed Mick's contribution in 4 ways:

- Str should not be used in such a way
- UsedRange needs to be qualified
- without a delimiter in the string variable, strange results could be obtained
- I shortened the code

Sub MG18Oct55_Wigi()
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        For Each Dn In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas
            myStr = ""
            For Each A In Dn
                myStr = myStr & "-" & A
            Next
            
            If Not .Exists(myStr) Then
                .Add myStr, Nothing
            Else
                Dn.ClearContents
            End If
        Next
    End With
End Sub