VBA to scan a worksheet for a specific value, and return the header and first column value

Hi folks !

I'm trying to find a way to scan an excel sheet for a value an return the header value and the first column value of the intersection in another sheet.

Basically, I have a sheet with headers (From B5 to CW5), and the A column also contains text values (A5 to A100).

The following range contains calculation (numbers) values (B6:CW100).

The logic would be :

1) Scan sheet1 (B6:CW100) for values <>0
2) when you get a value <>0,
- Copy the value that is <> 0 in column A of sheet2
- Copy the header (Value in row 5 of the intersection) in column B of sheet2
- Copy the value that is in column A of the intersection in column C of sheet2
3) It would have to be a Paste Value to make sure to get rid of the function

The idea is to take a matrix and turn it into a table that can be used for a pivot table...

Ex of data in sheet1 :

	X	Y	Z
ValueA	0	125	2000
Value B	5	0
Value C	0	12	500

The result would be in sheet2 :

Value	Column Header	Line Header
125	Y	Value A
2000	Z	Value A
5	X	Value B
12	Y	Value C
500	Z	Value C

Can anyone help me with this ? It seems like a decent challenge I tried looking for a solution online the whole day and I could not figure it out myself ...

Thanks a lot for your help !

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

Try this:

Sub sboivin(): Dim r As Long, c As Long, s As Long, P, Q
            Dim w1 As Worksheet, w2 As Worksheet: s = 1
    Set w1 = Sheets("Sheet1"): Set w2 = Sheets("Sheet2")
            w2.Cells.ClearContents: P = w1.UsedRange
Q = w2.Cells(1, 1).Resize((UBound(P, 1) - 5) * UBound(P, 2), 3)
Q(1, 1) = "Value": Q(1, 2) = "Column Header": Q(1, 3) = "Line Header"
    For r = 6 To UBound(P, 1): For c = 2 To UBound(P, 2)
                    If P(r, c) <> 0 Then
s = s + 1: Q(s, 1) = P(r, c): Q(s, 2) = P(5, c): Q(s, 3) = P(r, 1)
                    End If: Next c: Next r
            w2.Cells(1, 1).Resize(s, 3) = Q
            w2.UsedRange.Borders.Weight = xlMedium
End Sub

and let me know

BTW - I moved your sheet 1 sample down a row to start in B6.

You're welcome and thanks for the rep!

BTW - Please mark this thread as solved, you can do it in Thread Tools