Lookup horizontally, that will populate a vertical list based on a cell having any value

[nzskater]

Would appreciate some help creating a formula to make my life a little easier. I need to create a two column list based on the information below (actual data set is over 1000 rows and 320 reference columns).

As in the example below, I need the output to list each instance of an Item # (C2~) where there is a value in G2~, but the returned value that it populates in the list needs to be from the header in G1~. It needs to ignore any ref # values that have an empty cell, and it needs to output the data vertically. Hopefully that makes sense.

I don't have control of the input sheet or output format as it's system driven. It's a large data set (over 300k possible permutations) hence wanting to do this systematically instead of manually... Any help would be much appreciated.

Output list example is A7-B18.

 

[alansidman]

Cannot manipulate data in a picture. Please re-upload your sample using XL2BB so that we don't have to re-type your data to test a solution.

 

[eiloken]

i create this function:

Public Function CustomLookup(ByVal indexarray As Range, ByVal loouprange As Range, ByVal Criteria As String)
    Dim cll As Range, fcl As Range, rng As Range
    Dim iarr() As Variant
    Dim icoll As New Collection, lcoll As New Collection
    Dim i As Integer
    Set indexarray = Intersect(indexarray, ActiveSheet.UsedRange)
    Set loouprange = Intersect(loouprange, ActiveSheet.UsedRange)
    If Intersect(indexarray.Resize(indexarray.Rows.Count, Columns.Count), loouprange) Is Nothing Then
        CustomLookup = CVErr(xlErrRef)
        Exit Function
    End If
    For Each cll In indexarray
        If Not IsEmpty(cll) And Not IsError(cll) Then
            Set rng = Intersect(cll.Resize(1, Columns.Count), loouprange)
            If Not rng Is Nothing Then
                For Each fcl In rng
                    If Not Criteria = "" Then
                        If fcl.Value = Criteria Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    Else
                        If Not IsEmpty(fcl) Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    End If
                Next fcl
            End If
        End If
    Next cll
    If icoll.Count > 0 Then
        ReDim iarr(1 To icoll.Count, 1 To 2)
        For i = 1 To icoll.Count
            iarr(i, 1) = icoll(i)
            iarr(i, 2) = lcoll(i)
        Next i
        CustomLookup = iarr
    Else
        CustomLookup = CVErr(xlErrNA)
    End If
End Function

in your data sheet, enter this formula:

=CustomLookup(A2:A3,G1:U3,"")

to lookup for all nonblank data or

=CustomLookup(A2:A3,G1:U3,"type your lookup value here")

to lookup exact your text you want

 

[nzskater]

Cannot manipulate data in a picture. Please re-upload your sample using XL2BB so that we don't have to re-type your data to test a solution.

Thanks for your input - it looks like policy is preventing me from installing the add-in, otherwise I would have posted using it. Apologies!

 

[nzskater]

i create this function:

Public Function CustomLookup(ByVal indexarray As Range, ByVal loouprange As Range, ByVal Criteria As String)
    Dim cll As Range, fcl As Range, rng As Range
    Dim iarr() As Variant
    Dim icoll As New Collection, lcoll As New Collection
    Dim i As Integer
    Set indexarray = Intersect(indexarray, ActiveSheet.UsedRange)
    Set loouprange = Intersect(loouprange, ActiveSheet.UsedRange)
    If Intersect(indexarray.Resize(indexarray.Rows.Count, Columns.Count), loouprange) Is Nothing Then
        CustomLookup = CVErr(xlErrRef)
        Exit Function
    End If
    For Each cll In indexarray
        If Not IsEmpty(cll) And Not IsError(cll) Then
            Set rng = Intersect(cll.Resize(1, Columns.Count), loouprange)
            If Not rng Is Nothing Then
                For Each fcl In rng
                    If Not Criteria = "" Then
                        If fcl.Value = Criteria Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    Else
                        If Not IsEmpty(fcl) Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    End If
                Next fcl
            End If
        End If
    Next cll
    If icoll.Count > 0 Then
        ReDim iarr(1 To icoll.Count, 1 To 2)
        For i = 1 To icoll.Count
            iarr(i, 1) = icoll(i)
            iarr(i, 2) = lcoll(i)
        Next i
        CustomLookup = iarr
    Else
        CustomLookup = CVErr(xlErrNA)
    End If
End Function

in your data sheet, enter this formula:

=CustomLookup(A2:A3,G1:U3,"")

to lookup for all nonblank data or

=CustomLookup(A2:A3,G1:U3,"type your lookup value here")

to lookup exact your text you want

Thanks, that both works and does not - in isolation of the test sheet and against column A it works, but if I change the range in the CustomLookup formula it does not - it seems to error for any range outside of column A. But I got what I needed - just modified the data set to exclude unneeded columns and used A, and it worked. Thank you, you saved someone manually checking 300k lines and produced a list of 32k entries

 

[eiloken]

Thanks, that both works and does not - in isolation of the test sheet and against column A it works, but if I change the range in the CustomLookup formula it does not - it seems to error for any range outside of column A. But I got what I needed - just modified the data set to exclude unneeded columns and used A, and it worked. Thank you, you saved someone manually checking 300k lines and produced a list of 32k entries

yeah, it worked when indexarray in left of lookuprange, if you want it work for another index array, you can change like this:

Public Function CustomLookup(ByVal indexarray As Range, ByVal loouprange As Range, ByVal Criteria As String)
    Dim cll As Range, fcl As Range, rng As Range
    Dim iarr() As Variant
    Dim icoll As New Collection, lcoll As New Collection
    Dim i As Long 'if your data too large then change this to long
    Set indexarray = Intersect(indexarray, ActiveSheet.UsedRange)
    Set loouprange = Intersect(loouprange, ActiveSheet.UsedRange)
    If Intersect(indexarray.Resize(indexarray.Rows.Count, Columns.Count), loouprange) Is Nothing Then
        CustomLookup = CVErr(xlErrRef)
        Exit Function
    End If
    For Each cll In indexarray
        If Not IsEmpty(cll) And Not IsError(cll) Then
            Set rng = Intersect(cll.Worksheet.Cells(cll.Row, 1).Resize(1, Columns.Count), loouprange) 'change this
            If Not rng Is Nothing Then
                For Each fcl In rng
                    If Not Criteria = "" Then
                        If fcl.Value = Criteria Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    Else
                        If Not IsEmpty(fcl) Then
                            icoll.Add cll.Value
                            lcoll.Add fcl.Offset(loouprange.Cells(1).Row - fcl.Row)
                        End If
                    End If
                Next fcl
            End If
        End If
    Next cll
    If icoll.Count > 0 Then
        ReDim iarr(1 To icoll.Count, 1 To 2)
        For i = 1 To icoll.Count
            iarr(i, 1) = icoll(i)
            iarr(i, 2) = lcoll(i)
        Next i
        CustomLookup = iarr
    Else
        CustomLookup = CVErr(xlErrNA)
    End If
End Function

 

[Fluff]

A formula solution

Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1							ref 1	ref 2	ref 3	ref 4	ref 5	ref 6	ref 7	ref 8	ref 9	ref 10	ref 11
2			ITM-01				a						a		a		a
3			ITM-02						a		a	a	a
4			ITM-03					a			a		a		a	a	a
5
6
7
8
9
10
11
12
13	ITM-01	ref 1
14	ITM-01	ref 7
15	ITM-01	ref 9
16	ITM-01	ref 11
17	ITM-02	ref 3
18	ITM-02	ref 5
19	ITM-02	ref 6
20	ITM-02	ref 7
21	ITM-03	ref 2
22	ITM-03	ref 5
23	ITM-03	ref 7
24	ITM-03	ref 9
25	ITM-03	ref 10
26	ITM-03	ref 11
Data

Cell Formulas
Range	Formula
A13:B26	A13	=HSTACK(TOCOL(IF(G2:Q10<>"",C2:C10,1/0),2),TOCOL(IF(G2:Q10<>"",G1:Q1,1/0),2))
Dynamic array formulas.

 

[alansidman]

An alternative means with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Column1"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Value"})
in
    #"Removed Columns"

 

[nzskater]

Thanks all, really appreciate you sharing your expertise!

 

[Fluff]

Glad we could help & thanks for the feedback.