VBA: Make list from table without header and first column and omit the zeros

[Styx]

Hi All,
I am new on this forum, but I am using a lot of your solutions already, thanks for that!
Now I have an issue for which I can't find an "exact" solution, while my question may sound very familiar.
The solution may be VBA or a formula. I just want a list of every "non zero" from a table.
The original table is 529 rows x35 colums with a header and a leading column, the example below is just for reference.
There will be a lot of zero's in the table, so the list will not be extremely long.
Already played around with Cells(1).CurrenRegion and UBound, but nothing comes near.

Thanks in advance for all the help.

Table-list.xlsm
	A	B	C	D	E	F	G	H	I	J
1		a	b	c	d	e			hhhh
2	1	hhhh	0	mmmm	nnnn	pppp		result -->	rrrr
3	2	rrrr	0	ssss	eeee	ffff			iiii
4	3	iiii	0	llll	0	0			qqqq
5	4	qqqq	0	0	0	0			jjjj
6	5	jjjj	0	0	0	0			oooo
7	6	oooo	aaaa	0	0	gggg			aaaa
8	7	0	bbbb	0	0	0			bbbb
9	8	0	kkkk	cccc	0	0			kkkk
10	9	0	0	0	0	0			mmmm
11	10	0	0	0	0	0			ssss
12									llll
13									cccc
14									nnnn
15									eeee
16									pppp
17									ffff
18									gggg
19
Blad1

 

[Fluff]

How about

Sub styx()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Range("B2:F" & Range("A" & Rows.Count).End(xlUp).Row).Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 1)
   
   For r = 1 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         If Ary(r, c) <> 0 Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, c)
         End If
      Next c
   Next r
   Range("I2").Resize(nr, 1).Value = Nary
End Sub

 

[Styx]

Hi Fluff,
Extremely fast reaction, thanks!
I'll test it ASAP.

 

[Fluff]

Ok

 

[Styx]

100% Match for this small table, thanks!
Just have to test it in my large table this weekend.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Styx]

Tested it this weekend, works like a charm !
Thanks again.

 

[mohadin]

Hi
Another option Might be faster
1- keep the duplicates if there is any

Sub test()
Dim a As Variant
Dim i, ii As Long
a = Range("b2").CurrentRegion
Columns("I").ClearContents
With CreateObject("scripting.dictionarY")
    For i = 2 To UBound(a)
        For ii = 2 To UBound(a, 2)
                If a(i, ii) <> 0 And Not .exists(a(i, ii)) Then
            .Add .Count, a(i, ii)
            End If
    Next: Next
    Range("I2").Resize(.Count).Value = Application.Transpose(.items)
    End With
End Sub

2- Remove duplicates

Sub test1()
Dim a As Variant
Dim i, ii As Long
Columns("I").ClearContents
a = Range("b2").CurrentRegion
With CreateObject("scripting.dictionarY")
    For i = 2 To UBound(a)
        For ii = 2 To UBound(a, 2)
            If a(i, ii) <> 0 Then
                If a(i, ii) <> 0 And Not .exists(a(i, ii)) Then
                .Add a(i, ii), ""
            End If: End If
    Next: Next
    Range("I2").Resize(.Count).Value = Application.Transpose(.keys)
    End With
End Sub

 

[Styx]

Hi Mohadin,

 

[Styx]

thanks for your answer, I'll test this one too.