Create a table with a specific number of rows

[Undina]

Hi, I have 0 coding experience and am hoping someone can help me solve a fairly simple task. Say, I have a table with 5 rows and 3 columns. Let's say row names are Uno, Due, Tre, QUattro, Cinque, and column names are Alpha, Beta, Gamma. Users input numerical values in cells in this table. I need to create a new table in a separate tab where each row is: First Column - name of the row from original
Second Column: name of the column from original
Third Column - a drop down list, same list for all the rows
And most importantly, the number of rows equals the number that the user inputted in the original table for the cmbination. So I need to take this:

And transform into this:

I hope this makes sesne. Any help would be greatly appreciated.

 

[Trebor76]

Hi Undina,

Welcome to MrExcel!!

Apart from the drop-down this will do what you're after:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long, lngRowPaste As Long, lngRecCount As Long
    Dim lngCol As Long, lngColFrom As Long, lngColTo As Long 'Columns
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing the raw data. Change to suit.
    Set wsDestin = ThisWorkbook.Sheets("Sheet2") '<-Sheet name for the formatted raw data. Change to suit.
    
    lngRowFrom = 2
    lngRowTo = wsSrc.Cells(Rows.Count, "A").End(xlUp).Row
    lngColFrom = 2
    
    For lngRow = lngRowFrom To lngRowTo
        lngColTo = wsSrc.Cells(lngRow, Columns.Count).End(xlToLeft).Column
        For lngCol = lngColFrom To lngColTo
            If wsSrc.Cells(lngRow, lngCol) > 0 Then
                lngRecCount = wsSrc.Cells(lngRow, lngCol)
                lngRowPaste = IIf(lngRowPaste = 0, 1, wsDestin.Cells(Rows.Count, "A").End(xlUp).Row + 1)
                wsDestin.Range("A" & lngRowPaste & ":A" & (lngRowPaste + lngRecCount) - 1).Value = wsSrc.Cells(lngRow, 1)
                wsDestin.Range("B" & lngRowPaste & ":B" & (lngRowPaste + lngRecCount) - 1).Value = wsSrc.Cells(1, lngCol)
            End If
        Next lngCol
    Next lngRow
    
    Application.ScreenUpdating = True

End Sub

For the drop-down I need more information - what is the list? Is it in a sheet and if so what's the cell address or its named range?

Regards,

Robert

 

[Undina]

Hi Undina,

Welcome to MrExcel!!

Apart from the drop-down this will do what you're after:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long, lngRowPaste As Long, lngRecCount As Long
    Dim lngCol As Long, lngColFrom As Long, lngColTo As Long 'Columns
   
    Application.ScreenUpdating = False
   
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing the raw data. Change to suit.
    Set wsDestin = ThisWorkbook.Sheets("Sheet2") '<-Sheet name for the formatted raw data. Change to suit.
   
    lngRowFrom = 2
    lngRowTo = wsSrc.Cells(Rows.Count, "A").End(xlUp).Row
    lngColFrom = 2
   
    For lngRow = lngRowFrom To lngRowTo
        lngColTo = wsSrc.Cells(lngRow, Columns.Count).End(xlToLeft).Column
        For lngCol = lngColFrom To lngColTo
            If wsSrc.Cells(lngRow, lngCol) > 0 Then
                lngRecCount = wsSrc.Cells(lngRow, lngCol)
                lngRowPaste = IIf(lngRowPaste = 0, 1, wsDestin.Cells(Rows.Count, "A").End(xlUp).Row + 1)
                wsDestin.Range("A" & lngRowPaste & ":A" & (lngRowPaste + lngRecCount) - 1).Value = wsSrc.Cells(lngRow, 1)
                wsDestin.Range("B" & lngRowPaste & ":B" & (lngRowPaste + lngRecCount) - 1).Value = wsSrc.Cells(1, lngCol)
            End If
        Next lngCol
    Next lngRow
   
    Application.ScreenUpdating = True

End Sub

For the drop-down I need more information - what is the list? Is it in a sheet and if so what's the cell address or its named range?

Regards,

Robert

Robert,
Thank you so so so much! Life saver!!

 

[Trebor76]

Robert,
Thank you so so so much! Life saver!!

You're welcome