Count duplicates in in A, then duplicates in B in that range, then work with data in B

zookeepertx

zookeepertx

Well-known Member
Joined
May 27, 2011
Messages
589
Office Version
  1. 365
Platform
  1. Windows
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]I
[/TD]
[TD="align: center"]Z
[/TD]
[TD="align: center"]AA
[/TD]
[TD="align: center"]AB
[/TD]
[TD="align: center"]AC
[/TD]
[/TR]
[TR]
[TD]Once
[/TD]
[TD]fine
[/TD]
[TD]Once
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Same
[/TD]
[TD]Double
[/TD]
[TD]Twice[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Same
[/TD]
[TD]Double
[/TD]
[TD]Same
[/TD]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Different
[/TD]
[TD]New
[/TD]
[TD]Third[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fourth
[/TD]
[TD]Match
[/TD]
[TD]Different
[/TD]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fourth
[/TD]
[TD]Match
[/TD]
[TD]Fourth
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fourth
[/TD]
[TD]Normal
[/TD]
[TD]Five[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fourth[/TD]
[TD]Opposite
[/TD]
[TD]Sixth[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Help
[/TD]
[TD]Sign
[/TD]
[TD]Apple[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Help
[/TD]
[TD]Street
[/TD]
[TD]Help[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid"]
<tbody>[TR]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]I
[/TD]
[TD="align: center"]Z
[/TD]
[TD="align: center"]AA
[/TD]
[TD="align: center"]AB
[/TD]
[TD="align: center"]AC
[/TD]
[/TR]
[TR]
[TD]Once
[/TD]
[TD]fine
[/TD]
[TD]Once
[/TD]
[TD]fine
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]Twice[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Same
[/TD]
[TD]Double
[/TD]
[TD]Same
[/TD]
[TD]Double
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Third[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Different[/TD]
[TD]New[/TD]
[TD]Different
[/TD]
[TD]New
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fourth
[/TD]
[TD]Match
[/TD]
[TD]Fourth
[/TD]
[TD]Match
[/TD]
[TD]Normal
[/TD]
[TD]Opposite[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]Five[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]
[/TD]
[TD]Sixth[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]Apple[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Help
[/TD]
[TD]Sign
[/TD]
[TD]Help[/TD]
[TD]Sign[/TD]
[TD]Street[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I've been working on this for just about ever and am SICK of looking at it! Please help!

I need to find the data from column I in column A and - in the simplest case - return the data in column B into column Z.

* If there's no match in A for I, move all of columns A:B down - (ultimately, to where there IS a match in A for I).

* If there's 1 match in A for I, return data from B into column Z.
-If the row # in A isn't "level with" the row # it's matched with in I
~Move all of columns A:B down to where they are "level with" the row in I that A is matched with.

* If there are 2 matches in A for I, then:
-If B on the first row = B on the second row, return data from the first row where A matched, into Z.
-Delete A:B of the second matched A
-Move all of columns A:B down to where they are "level with" the row in I that A is matched with.
-If B on the second row <> B on the first row, return the first B into Z and the second B into AA.
-Delete A:B of the second matched A
-Move all of columns A:B down to where they are "level with" the row in I that A is matched with.

*If there are more than 2 matches in A for I, then:
-Return data from the first row where A matched into Z.
-If B on the subsequent rows = B on any of the above rows, then ignore the data in THAT B only.
-If B on the first row <> B on any of the above rows, return each subsequent non-duplicated B into the columns after Z.
-Delete A:B of all of the matched A's after the first one.
-Move all of columns A:B down to where they are "level with" the row in I that A is matched with.

MAN, this is hard to explain with words!! I hope I've made some sense!

The tables above show a small version of the original and then a small version of the desired result.

I hope someone can figure this out for me, because I'm getting nowhere fast! :banghead:

Thanks

Jenny
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Ok, I hope I understood this correctly. Here is the vba code I came up with:

Code: 
Sub craziness()


Dim ABC() As Variant
Dim XYZ() As Variant
Dim Ran As Range
Dim BB As Integer
Dim CC As Integer
Dim DD As Integer
Dim EE As Integer


Set Ran = Range("A1:AC10")
ReDim ABC(1 To 10, 1 To 29)
ReDim XYZ(1 To 10, 1 To 29)
ABC = Ran


For BB = 1 To 10
    XYZ(BB, 9) = ABC(BB, 9)
    DD = 0
    For CC = 1 To 10
        If XYZ(BB, 9) = ABC(CC, 1) Then
            DD = DD + 1
            If DD = 1 Then
                XYZ(BB, 1) = ABC(CC, 1)
                XYZ(BB, 2) = ABC(CC, 2)
            End If
            For EE = 1 To DD
                If XYZ(BB, 25 + EE) = ABC(CC, 2) Then
                    Exit For
                Else
                    If XYZ(BB, 25 + EE) = Empty Then
                        XYZ(BB, 25 + EE) = ABC(CC, 2)
                        Exit For
                    End If
                End If
            Next EE
        End If
    Next CC
Next BB


For BB = 1 To 10
    ABC(BB, 1) = XYZ(BB, 1)
    ABC(BB, 2) = XYZ(BB, 2)
    ABC(BB, 9) = XYZ(BB, 9)
    ABC(BB, 26) = XYZ(BB, 26)
    ABC(BB, 27) = XYZ(BB, 27)
    ABC(BB, 28) = XYZ(BB, 28)
    ABC(BB, 29) = XYZ(BB, 29)
Next BB
Ran = ABC


End Sub

If the data you are using this for, extends beyond the 10 rows in your example, or if there is the possiblilty of more than 4 matches that will go in columns Z through AC, then some of the code will need to be edited.

I hope this helps.
 
Upvote 0
Another option :-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG15Dec51
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Dn
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   ReDim ray(1 To Rng.Count, 1 To 2)
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, 8)
      c = 0
      
      [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(Dn.Value)
            c = c + 1
            Dn.Offset(, 16 + c) = p
            [COLOR="Navy"]If[/COLOR] c = 1 [COLOR="Navy"]Then[/COLOR]
                ray(Dn.Row, 1) = Dic(Dn.Value).Item(p)
                ray(Dn.Row, 2) = Dic(Dn.Value).Item(p).Offset(, 1)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] p
      [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Range("A1").Resize(Rng.Count, 2).Value = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi RSpin!

I finally got a chance to get back here!

Your code works great after I made a few minor adjustments! However, there is definitely the possibility of more than 4 matches, so it does need to be able to use as many columns as required. There's no telling how many there may be; there probably won't be more than 4-5, but you never know. Can the "results range" be dynamic?

Thank you!

Jenny
 
Upvote 0
Hello again MickG!

Your coding works 99% perfectly - I just had to make a couple of small adjustments on references - and I can definitely work with it as is. The only thing (a small thing) is that somehow, the data in A:B ends up 1 row below the data in the other columns. For example, if the match for I2 is originally in A2, after the macro, A2:B2 end up in A3:B3. Not sure how or when that happens, because I can't decipher the most important part of the coding, LOL!

If it's a pain to change that, my end-user can absolutely deal with it.

Thank you very much! I'm over here doing a happy dance :beerchug:

Jenny
 
Upvote 0
zookeepertx said:
... there is definitely the possibility of more than 4 matches, so it does need to be able to use as many columns as required. There's no telling how many there may be; there probably won't be more than 4-5, but you never know. Can the "results range" be dynamic?
Click to expand...

My apologies. I did not even consider making the range dynamic. I rewrote some of the code allowing for a fully dynamic number of matches, and rows. Although, if you don't want the number of rows to be dynamic, then you can simply replace the "Lrow = find_last_row_code" with "Lrow = 10" (or however many rows you want).

Code: 
 Sub craziness()

Dim ABC() As Variant
Dim XYZ() As Variant
Dim Ran As Range
Dim BB As Integer
Dim CC As Integer
Dim DD As Integer
Dim EE As Integer
Dim FF As Integer
Dim Lrow As Long
Dim ColumnString As String


Lrow = ActiveSheet.UsedRange.Rows.Count
Set Ran = Range("A1:Y" & Lrow)
ReDim ABC(1 To Lrow, 1 To 25)
ReDim XYZ(1 To Lrow, 1 To 25)
ABC = Ran
FF = 0


For BB = 1 To Lrow
    XYZ(BB, 9) = ABC(BB, 9)
    DD = 0
    For CC = 1 To Lrow
        If XYZ(BB, 9) = ABC(CC, 1) Then
            DD = DD + 1
            If DD = 1 Then
                XYZ(BB, 1) = ABC(CC, 1)
                XYZ(BB, 2) = ABC(CC, 2)
            End If
            If DD > FF Then
                FF = DD
                ReDim Preserve XYZ(1 To Lrow, 1 To (25 + FF))
                ReDim Preserve ABC(1 To Lrow, 1 To (25 + FF))
            End If
            For EE = 1 To DD
                If XYZ(BB, 25 + EE) = ABC(CC, 2) Then
                    Exit For
                Else
                    If XYZ(BB, 25 + EE) = Empty Then
                        XYZ(BB, 25 + EE) = ABC(CC, 2)
                        Exit For
                    End If
                End If
            Next EE
        End If
    Next CC
Next BB


For BB = 1 To Lrow
    ABC(BB, 1) = XYZ(BB, 1)
    ABC(BB, 2) = XYZ(BB, 2)
    ABC(BB, 9) = XYZ(BB, 9)
    If FF > 0 Then
        For CC = 26 To UBound(ABC, 2)
            ABC(BB, CC) = XYZ(BB, CC)
        Next CC
    End If
Next BB


' Find Last used column letter
If UBound(XYZ, 2) > 26 Then
    BB = Int(UBound(XYZ, 2) / 26)
    CC = UBound(XYZ, 2) - (BB * 26)
    ColumnString = Chr(BB + 64) & Chr(CC + 64)
Else
    ColumnString = Chr(UBound(XYZ, 2) + 64)
End If
Set Ran = Range("A1:" & ColumnString & Lrow)
Ran = ABC




End Sub

zookeepertx said:
Your code works great after I made a few minor adjustments!
Click to expand...

Unfortunately, you will probably have to make those adustments again, as I modified the code I sent you the first time. Let me know if this works out for you.
 
Upvote 0
It could be because your actual data starts in "A2",and not in "A1", is that the case ????
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
partial match - Vlookup
Replies
3
Views
215
Cubist
Cubist
W
  • Question Question
Index/Match Duplicate Values With No Helper Cells
Replies
3
Views
409
Domenic
D
B
  • Question Question
Closest Match in a Range
Replies
1
Views
382
Rijnsent
Rijnsent
T
  • Question Question
Moving address list to columns from rows
Replies
3
Views
96
Sufiyan97
Sufiyan97
B
  • Question Question
Lookup Help without Duplication
Replies
2
Views
87
Blake86
B

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,021
Latest member
Justyna P

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