Pull the column title and row title of a matrix - vba

Question

So i have a matrix formatted as so:
| | joe | michelle | tom |
|:-----: |:---: |:--------: |:---: |
| red | 1 | 0 | 1 |
| blue | 0 | 1 | 0 |
| green | 0 | 0 | 0 |
I'm trying to write VBA in excel to create two columns based on this table. If the cell inside the matrix is equal to "1", then I want to write the column name and row name into a list. So for example, because row "red" has a "1" in columns "joe" and "tom", and row "blue" has a "1" under "michelle", my new table would be like this:
| joe | red |
| tom | red |
| michelle | blue |
Here is the VBA i wrote so far, but it doesn't work and i hit a road block.
sub subname()
dim i as integer
for i = 1 to 3
if cells(2,i).value=1 then
cell(5,i).value = cells(1,i).value
end if
next i
end sub

Answer 1

You have only one cycle ...
Dim x As Integer
Range("B19").Select
x = 4
For i = 1 To 3 ' Row
For e = 1 To 3 ' Column
If ActiveCell.Offset(i, e).Value = "1" Then
x = x + 1
ActiveCell.Offset(x, 0).Value = ActiveCell.Offset(0, e).Value
ActiveCell.Offset(x, 1).Value = ActiveCell.Offset(i, 0).Value
End If
Next
Next
I consider B19 the top_left corner of the table ...
Ok the correct code is:
Dim i As Integer
For i = 1 To 3
If Cells(2, i + 1).Value = 1 Then
Cells(5, 1).Value = Cells(1, i + 1).Value
End If
Next i
If the top_left of the table is A1 The error is the reference of i. You need to add 1 or change the cycle from 2 to 4.The second "error" it's to put the value in cell(5,i) instead of cells(5,1). In that case you have to put the name in a fix position. In a cycle you change in Cells(5+e,1)...

Answer 2

You can use this code also.
Sub prabhat()
Dim rng As Range
Dim r As Integer
Dim c As Integer
Dim lastRow As Integer
Dim lastRow2 As Integer
Set rng = Range("a2:d4")
For Each dng In rng
lastRow = Range("E" & Rows.Count).End(xlUp).Row
lastRow2 = Range("F" & Rows.Count).End(xlUp).Row
If dng.Value = 1 Then
r = dng.Row
c = dng.Column
Range("E" & lastRow + 1).Value = Cells(r, 1).Value
Range("F" & lastRow2 + 1).Value = Cells(1, c).Value
End If
Next dng
End Sub