Modify Index Small Row Formula to summarize all Rows

[Leesa B]

Looking for help in the following:

Trying to move data in multiple rows in tab "Colors" to one row on "Summary" tab.

Colors tab looks like this:
A B C D
1 Red 1 2
2 Red 10 11 15
3 Red 23 150 256
4 Blue 5 6 7
5 Blue 1 11 15
6 Green 23

I have 3000 Colors in column A on the Colors tab.

I would like the Summary tab to look like this, pulling all the data from the Colors tab:
A B C D E F G H
1 Red 1 2 10 11 15 23 150 256
2 Blue 5 6 7 1 11 15
3 Green 23

I have been able to get the first row for each color using the formula below, but I need to modify it so that when it gets to the end of the row (blank), it goes to the next row.

{=INDEX(Colors!$A$1:$AV$23851,SMALL(IF(Colors!$A:$A='Summary'!$A1,ROW(Colors!$A:$A)),ROW(1:1)),D$2)}

I have D$2 referencing a column number, but that may be incorrect if the formula is modified.
Any help is much appreciated!
Thank you in advance.

 

[Eric W]

Welcome to the MrExcel board.

I created a formula to do what you asked, but I have some questions. Are the colors grouped together? Do you have a list of the unique colors on the Summary tab, or do you need to calculate that? Are the values next to the colors numbers, text, or both? If they are all numbers, is 0 a valid option? On the Colors tab, can the values extend on each line all the way to column AV? Do you want the values returned in sorted order, or in the order they appear? Will there be duplicates? If so, do you want the duplicates listed individually, or just one instance?

Finally, you have a fairly large range, both in the input sheet and the output sheet. Each individual formula examines a LOT of cells, and if you have a lot of formulas on the Summary tab, it could really slow down your workbook. My sample sheet was noticeably slow, even with just 3 lines of output. Would you consider a VBA macro solution?

 

[Leesa B]

Hi, Eric.
The colors are grouped together on the Colors tab, so all the Red lines will be together, Blue lines together, etc.
The list of the colors is already on the Summary tab.
Values next to the colors are text, so 0 is not value that will be found.
On the Colors tab, the values for each color will vary in column length, but go no further than column AV. Some lines only have a value in column B, some will have values to column AV. Most lines will be in between.
Values do not have to be sorted in order on the Summary tab.
Duplicates may be possible (I didn't think of that) and I would prefer they only listed once.

I would be open to a VBA Macro solution, but I am an extreme novice in that area so as much guidance as could be given would be appreciated.

Thank you again!!

 

[Eric W]

Here's a first stab at what you want. This is a macro solution. Let's see how it works and go from there.

Open a COPY of your workbook. Press Alt-F11 to open the VBA editor. From the menu select Insert > Module. Paste the following code into the window that opens:

Public Sub GetColorData()
Dim MyData As Variant, MyDict As Object, r As Long, c As Long

    MyData = Sheets("Colors").Range("A1:AV23851").Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    
    For r = 1 To UBound(MyData)
        If MyData(r, 1) <> "" Then
            If MyDict(MyData(r, 1)) = "" Then MyDict(MyData(r, 1)) = MyData(r, 1) & "|"
            For c = 2 To UBound(MyData, 2)
                If MyData(r, c) <> "" Then
                    If InStr(MyDict(MyData(r, 1)), "|" & MyData(r, c) & "|") = 0 Then
                        MyDict(MyData(r, 1)) = MyDict(MyData(r, 1)) & MyData(r, c) & "|"
                    End If
                End If
            Next c
        End If
    Next r
    
    Sheets("Summary").Cells.ClearContents
    Sheets("Summary").Range("A1").Resize(MyDict.Count).Value = WorksheetFunction.Transpose(MyDict.items)
    Sheets("Summary").Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                        Other:=True, OtherChar:="|"
                
End Sub

Notice the parts in red, these are your sheet names and data ranges. Change as needed. This macro assumes you already have a tab named "Summary". It DELETES everything on that sheet, then recreates the list as needed. If you want to keep the list already there, then it would be a bit more work to match up the values with the colors. Or we could add a sort in the macro. Also note that upper/lower case matters: "Orange" and "orange" will go to different rows. This can also be changed if needed.

You can now close the editor (Alt-Q, or just use the red X in the upper right corner). Go back to Excel. Press Alt-F8 to open the macro selector, select GetColorData, and click Run.

Rerun it as needed the same way. It should run very quickly, and won't have any formulas to slow down your sheet. I might be able to come up with formulas to do this, but with your data being text, and wanting to remove duplicates, they'd be large and slow. Try this first. Let me know how it goes.

 

[Leesa B]

Eric.
I am so appreciative of your help.
I am getting a runtime error 13: Type mismatch. Do I need to format my Colors tab differently? It is currently all in Text format. Or does it have something to do with the range?

Here is the line with the error.
Sheets("Summary").Range("A1").Resize(MyDict.Count).Value = WorksheetFunction.Transpose(MyDict.items)

Thanks again.

 

[Eric W]

I had forgotten that the Transpose function has an upper limit - your data evidently exceeds that limit. Try this:

Public Sub GetColorData()
Dim MyData As Variant, MyDict As Object, r As Long, c As Long, MyOutput() As Variant, MyItems As Variant

    MyData = Sheets("Colors").Range("A1:AV23851").Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    
    For r = 1 To UBound(MyData)
        If MyData(r, 1) <> "" Then
            If MyDict(MyData(r, 1)) = "" Then MyDict(MyData(r, 1)) = MyData(r, 1) & "|"
            For c = 2 To UBound(MyData, 2)
                If MyData(r, c) <> "" Then
                    If InStr(MyDict(MyData(r, 1)), "|" & MyData(r, c) & "|") = 0 Then
                        MyDict(MyData(r, 1)) = MyDict(MyData(r, 1)) & MyData(r, c) & "|"
                    End If
                End If
            Next c
        End If
    Next r
    
    Sheets("Summary").Cells.ClearContents
    MyItems = MyDict.items
    ReDim MyOutput(0 To UBound(MyItems), 1 To 1)
    For r = 0 To UBound(MyItems)
        MyOutput(r, 1) = MyItems(r)
    Next r
    Sheets("Summary").Range("A1").Resize(MyDict.Count).Value = MyOutput
    Sheets("Summary").Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                        Other:=True, OtherChar:="|"
                
End Sub

 

[Leesa B]

THIS IS AWESOME!!!!!!

Thank you so very, very much! Wish I could buy you a beer.
I'm so excited this works.

Happy weekend!!

 

[Eric W]

I'm so glad it works for you!

It's always nice to go into the weekend on a high note.