Stumped Again

A

anwaee2

Board Regular
Joined
Sep 13, 2012
Messages
151
Office Version
  1. 2011
Platform
  1. MacOS
I can do a join/transpose with one column but nothing I have tried will do a join/transpose with the condition being in two columns. Below is a sample of what I am trying to do. Thanks for any help you may give.

[TABLE="width: 260"]
<colgroup><col width="65" span="4" style="width: 65pt;"></colgroup><tbody>[TR]
[TD="class: xl63, width: 65, align: center"][TABLE="width: 260"]
<colgroup><col width="65" span="4" style="width: 65pt;"></colgroup><tbody>[TR]
[TD="class: xl63, width: 65"]A[/TD]
[TD="class: xl63, width: 65"]B[/TD]
[TD="class: xl63, width: 65"]C[/TD]
[TD="class: xl63, width: 65"]D[/TD]
[/TR]
[TR]
[TD="class: xl63"]Fruit[/TD]
[TD="class: xl63"]Number[/TD]
[TD="class: xl63"]Sequence[/TD]
[TD="class: xl63"]Shown[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD="class: xl63"]#3[/TD]
[TD="class: xl63"]1[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]2[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]3[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Lemons[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]4[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD="class: xl63"]#1 [/TD]
[TD="class: xl63"]5[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Lemons[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]6[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Apples [/TD]
[TD="class: xl63"]#1 [/TD]
[TD="class: xl63"]7[/TD]
[TD="class: xl63"]3[/TD]
[/TR]
[TR]
[TD]Plums[/TD]
[TD="class: xl63"]#1 [/TD]
[TD="class: xl63"]8[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]9[/TD]
[TD="class: xl63"]3[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]10[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]11[/TD]
[TD="class: xl63"]3[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]12[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl64, colspan: 4, align: center"]FROM ABOVE TO BELOW[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl63"]A[/TD]
[TD="class: xl63"]B[/TD]
[TD="class: xl63"]C[/TD]
[TD="class: xl63"]D[/TD]
[/TR]
[TR]
[TD="class: xl63"]Fruit[/TD]
[TD="class: xl63"]Number[/TD]
[TD="class: xl63"]Sequence[/TD]
[TD="class: xl63"]Shown[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]7, 9, 11[/TD]
[TD="class: xl63"]3[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD="class: xl63"]#3[/TD]
[TD="class: xl63"]1[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Lemons[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]4, 6[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]2, 5[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]12[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]3[/TD]
[TD="class: xl63"]2[/TD]
[/TR]
[TR]
[TD]Pears[/TD]
[TD="class: xl63"]#2[/TD]
[TD="class: xl63"]10[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
[TR]
[TD]Plums[/TD]
[TD="class: xl63"]#1[/TD]
[TD="class: xl63"]8[/TD]
[TD="class: xl63"]1[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD="class: xl63, width: 65, align: center"][/TD]
[TD="class: xl63, width: 65, align: center"][/TD]
[TD="class: xl63, width: 65, align: center"][/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Update: I have been doing a copy/paste of the original each time I run it. I looked for spelling or anything else I could think of that might be different. I saw none but I did go back and retyped "Apples" again in each "Apples" cell. Well now both macros work fine. When I went back to the original I found that the Apples in Sequence 7 had a space after it that you of course could not see. I didn't know that hitting the space bar before hitting enter could cause something like that.

Thanks to both you and Mick for all the help. Again this forum is great.
 
Upvote 0

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Another option, give it a try:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Jan27
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rw [COLOR="Navy"]As[/COLOR] Range, r [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] Rng
Rw = Trim(Rw.Value)
[COLOR="Navy"]If[/COLOR] InStr(Rw, ",") = 0 [COLOR="Navy"]Then[/COLOR] Rw = Rw & "," & Rw.Offset(, 1).Value
r = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
      Dn = Trim(Dn.Value)
       [COLOR="Navy"]If[/COLOR] InStr(Dn, ",") = 0 [COLOR="Navy"]Then[/COLOR] Dn = Dn & "," & Dn.Offset(, 1).Value
            r = r + 1
        [COLOR="Navy"]If[/COLOR] Dn = Rw [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Application.CountIf(Rng(1).Resize(r), Rw) = 1 [COLOR="Navy"]Then[/COLOR]
               [COLOR="Navy"]Set[/COLOR] Temp = Rw
            [COLOR="Navy"]Else[/COLOR]
                Temp.Offset(, 2).Value = Temp.Offset(, 2).Value & "," & Dn.Offset(, 2).Value
                [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: Dn = Split(Dn.Value, ",")(0): [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
Rng.Resize(, 4).Sort key1:=[A2], order1:=xlAscending, Header:=xlYes

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Yet another option:- Results start "H1"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Jan41
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] r [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray() [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
Dn = Trim(Dn.Value)
  [COLOR="Navy"]If[/COLOR] InStr(Dn, ",") = 0 [COLOR="Navy"]Then[/COLOR] Dn = Dn & "," & Dn.Offset(, 1).Value
    r = r + 1
    [COLOR="Navy"]If[/COLOR] Application.CountIf(Rng(1).Resize(r), Dn) = 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        ReDim Preserve Ray(1 To c)
        Ray(c) = Dn.Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
c = 0
ReDim nray(1 To UBound(Ray) + 1, 1 To 4)
nray(1, 1) = "Fruit": nray(1, 2) = "Number": nray(1, 3) = "Sequence": nray(1, 4) = "Shown"

[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
      [COLOR="Navy"]If[/COLOR] Ray(n) = Dn [COLOR="Navy"]Then[/COLOR]
        nray(n + 1, 1) = Split(Dn.Value, ",")(0)
        nray(n + 1, 2) = Split(Dn.Value, ",")(1)
        nray(n + 1, 3) = nray(n + 1, 3) & IIf(nray(n + 1, 3) = "", Dn.Offset(, 2).Value, "," & Dn.Offset(, 2).Value)
        nray(n + 1, 4) = Dn.Offset(, 3).Value
      [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Range("H1").Resize(UBound(Ray, 1) + 1, 4)
    .Value = nray
    .Sort key1:=[H1], order1:=xlAscending, Header:=xlYes
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank you so much Mick. This one works great and doesn't seem to matter if there is an extra space or not. That will save me a lot of time not having to go back and check each cell. I will now apply this to a much larger data base. You guys are the best. Thanks again.

Larry

MickG said:
Another option, give it a try:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG10Jan27
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Rw [COLOR=Navy]As[/COLOR] Range, r [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Temp [COLOR=Navy]As[/COLOR] Range, nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Rw [COLOR=Navy]In[/COLOR] Rng
Rw = Trim(Rw.Value)
[COLOR=Navy]If[/COLOR] InStr(Rw, ",") = 0 [COLOR=Navy]Then[/COLOR] Rw = Rw & "," & Rw.Offset(, 1).Value
r = 0
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
      Dn = Trim(Dn.Value)
       [COLOR=Navy]If[/COLOR] InStr(Dn, ",") = 0 [COLOR=Navy]Then[/COLOR] Dn = Dn & "," & Dn.Offset(, 1).Value
            r = r + 1
        [COLOR=Navy]If[/COLOR] Dn = Rw [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Application.CountIf(Rng(1).Resize(r), Rw) = 1 [COLOR=Navy]Then[/COLOR]
               [COLOR=Navy]Set[/COLOR] Temp = Rw
            [COLOR=Navy]Else[/COLOR]
                Temp.Offset(, 2).Value = Temp.Offset(, 2).Value & "," & Dn.Offset(, 2).Value
                [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] Rw
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: Dn = Split(Dn.Value, ",")(0): [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
Rng.Resize(, 4).Sort key1:=[A2], order1:=xlAscending, Header:=xlYes

[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Textjoin and Filter using VBA
Replies
7
Views
192
BritsBlitz
B
P
  • Solved
Copy Values to an Adjacent Column per unique Customer
Replies
3
Views
393
Joe4
Joe4
S
  • Solved
Lookup results in a table based on multiple criteria and set number of occurrences
Replies
4
Views
330
kevin9999
K
T
  • Solved
Match with multiple columns
2
Replies
14
Views
744
Peter_SSs
Peter_SSs
ExcelNewbie2020
  • Question Question
lookup and distribute the qty based on capacity
Replies
1
Views
268
bobaol
B

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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