Extracting non zero cells from a data table

[JHE1969]

I have a large data table that takes the form of n rows of Reference1 and z columns of Reference2, for each cell there is an output data that is numeric. Many output cells are zero are blank. I need to extract the data relating to the non-zero cells in the form of a simple 3 column multiple row table where the columns are Reference1, Reference2, Amount. An example Input Data Table and a fraction of the desired output data table is shown below.

Input Table
	F00004	F00005	F00006	F00007
LB2000012	-	-	-	-
LB2000029	21,072.70	19,247.30	-	-
LB2000030	19.62	17.18	3.81	8.09
LB2000033	-	-	-	-
LB2000035	9,626.08	9,659.63	-	-
LB2000036	-	2,250.00	-	-
LB2000039	-	-	-	-
LB2000040	1,560.42	1,569.71	244.89	187.09
LB2000042	-	-	-	-
LB2000043	-	-	-	-
LB2000044	10,333.20	10,368.64	1,197.54	1,197.54
LB2000045	-	-	-	-
LB2000047	-	-	-	-
LB2000048	-	-	-	-
LB2000050	-	-	-	-
LB2000052	-	-	-	-
Desired Output Table
Ref1	Ref2	Amount
F00004	LB2000029	21,072.70
F00004	LB2000030	19.62
F00004	LB2000035	9,626.08
F00004	LB2000040	1,560.42
F00004	LB2000044	10,333.20
F00005	LB2000029	19,247.30
F00005	LB2000030	17.18
F00005	LB2000035	9,659.63
F00005	LB2000040	2,250.00
F00005	LB2000044	10,368.64

<tbody>
</tbody>

 

[Special-K99]

Not saying I'll answer this so this question is for the benefit of anyone that wants to solve this but VBA would be the best solution, would that suffice?

 

[JHE1969]

Never used VBA so no idea, always happy to try. Was hoping there might be a clever formulaic solution. Thanks as always.

 

[mumps]

Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro into the empty code window that opens up. Press the F5 key to run the macro. Close the code module window to return to your sheet. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key. The output will be in Sheet2.

Sub ExtractNonZero()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    Dim x As Long, y As Long
    For y = 2 To lColumn
        For x = 2 To LastRow
            If Len(Sheets("Sheet1").Cells(x, y)) > 1 Then
                Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(1, y)
                Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "B").End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, 1)
                Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "C").End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, y)
            End If
        Next x
    Next y
    Application.ScreenUpdating = True
End Sub