vba compare arrays and remove exact matching arrays

J

jacojvv

New Member
Joined
Aug 13, 2012
Messages
5
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)

[TABLE="class: cms_table, width: 384"]
<tbody>[TR]
[TD="width: 64, align: right"][TABLE="class: cms_table, width: 384"]
<tbody>[TR]
[TD="width: 64, align: right"]30[/TD]
[TD="width: 64, align: right"]16[/TD]
[TD="width: 64, align: right"]32[/TD]
[TD="width: 64, align: right"]36[/TD]
[TD="width: 64, align: right"]15[/TD]
[TD="width: 64, align: right"]23[/TD]
[/TR]
[TR]
[TD="align: right"]13[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]34[/TD]
[TD="align: right"]41[/TD]
[/TR]
[TR]
[TD="align: right"]27[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]33[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]37[/TD]
[/TR]
[TR]
[TD="align: right"]43[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]12[/TD]
[TD="align: right"]22[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]24[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]37[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]19[/TD]
[/TR]
[TR]
[TD="align: right"]22[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]41[/TD]
[/TR]
[TR]
[TD="align: right"]33[/TD]
[TD="align: right"]36[/TD]
[TD="align: right"]34[/TD]
[TD="align: right"]32[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD="align: right"]45[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]27[/TD]
[/TR]
[TR]
[TD="align: right"]39[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]23[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]17[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"]37[/TD]
[TD="align: right"]34[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]36[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD="align: right"]43[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]33[/TD]
[TD="align: right"]22[/TD]
[/TR]
[TR]
[TD="align: right"]45[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD="align: right"]18[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]23[/TD]
[TD="align: right"]41[/TD]
[TD="align: right"]32[/TD]
[TD="align: right"]27[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]12[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]34[/TD]
[TD="align: right"]33[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]30[/TD]
[/TR]
[TR]
[TD="align: right"]17[/TD]
[TD="align: right"]41[/TD]
[TD="align: right"]22[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]36[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD="align: right"]25[/TD]
[TD="align: right"]37[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]27[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]19[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD="align: right"]23[/TD]
[TD="align: right"]24[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]32[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]30[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"]32[/TD]
[TD="align: right"]36[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]23[/TD]
[/TR]
[TR]
[TD="align: right"]13[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]34[/TD]
[TD="align: right"]41[/TD]
[/TR]
[TR]
[TD="align: right"]27[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]33[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]37[/TD]
[/TR]
[TR]
[TD="align: right"]43[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]12[/TD]
[TD="align: right"]22[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]24[/TD]
[TD="align: right"]18[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Hello,

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

Code: 
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
 
Upvote 0
Try this:-
Code: 
[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
 
Upvote 0
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


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
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
counting duplicates error
Replies
2
Views
223
excelNewbie22
E
R
  • Solved
Application.Intersect Range targeting Another Sheet's Cell Value
Replies
5
Views
208
Joe4
Joe4
J
  • Question Question
Removing blank rows based on cell value
Replies
2
Views
492
Peter_SSs
Peter_SSs
V
  • Solved
Dynamic arrays, circular arguments and all I want to due is increment a previous number
Replies
3
Views
292
djclements
djclements
S
  • Solved
Individual Ranking
2
Replies
11
Views
591
sksanjeev786
S

Share this page

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
Back
Top