split a single row of data into multiple unique rows into a new sheet to include headers as values and cell contents as values

Question

I have found quite a lot of data splitting VBA code posts but none that splits it by contents and pulls in the header and puts the results into a new sheet (I need the original data to be left in its original state).

I have a spreadsheet that contains values in columns with a country as a header and I need to split each row into new rows in a new sheet with the country listed in a new column and the value from the same country column in the new row.

I want to ignore any country headers where the cell contents are blank as in the example with row 3.

This is a small example of the raw data:

And this is what I need the 3 rows to turn into:

Although I am asking about VBA code I do not yet know how to write VBA and only adjust code that I have found on the internet to fit my scenario.

Answer 1

Since you are new to coding VBA, i made a simple code with For and If, try to learn this functions. I didn't declare every variable, try to declare them and learn about data types. last_row and last_column are variables that can help a lot in Excel VBA, mainly to make dynamic spreadsheets

Sub test()
'Declare variables here
Dim sht1, sht2 As Worksheet

'sht1 has the data and sht2 is the output Worksheet, you can change the names
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")

last_row1 = sht1.Range("A65536").End(xlUp).Row
last_column = sht1.Cells(1, sht1.Columns.Count).End(xlToLeft).Column
x = 1

'Add header
sht2.Cells(1, 1) = "Company"
sht2.Cells(1, 2) = "Country"
sht2.Cells(1, 3) = "Status"
'Data add
For i = 2 To last_row1
'Assuming Company is in Column 1 or A
    For k = 2 To last_column
        'If cell is different from blank then write data
        If sht1.Cells(i, k) <> "" Then
        sht2.Cells(x + 1, 1) = sht1.Cells(i, 1)
        sht2.Cells(x + 1, 2) = sht1.Cells(1, k)
        sht2.Cells(x + 1, 3) = sht1.Cells(i, k)
        x = x + 1
        End If
    Next k
Next i

MsgBox "Data Updated"
End Sub

Next time, try to learn some coding and post your code.