Creating an Excel Macro to populate values

Question

Creating macros in Excel is not my strong point so I'm wondering if someone is able to help. I have a small table with product values, though not every cell has a value. What I'm trying to do is write a macro to create a list on a separate sheet. The macro I have written works for the first column but that's where it stops. For example ``` List | aa | bb | cc a |1 | 15 | - b |2 | 23 | 12 c |- | 17 | 5 d |4 | - | - ``` Should appear on Sheet 2 like so ``` - List| aa - a | 1 - b | 2 - d | 4 - List| bb - a | 15 - b | 23 - c | 17 - List| cc - b | 12 - c | 5 ``` At the moment, only aa shows correctly on the 2nd sheet and none of the other columns. The macro I have so far is ``` Sub Button2_Click() Dim Column As Integer Column = 1 newrow = 1 Do Until Worksheets("Sheet1").Cells(Column, 1).Value = "" If Worksheets("Sheet1").Cells(Column, 2).Value <> "" Then Worksheets("Sheet2").Cells(newrow, 1).Value = Worksheets("Sheet1").Cells(Column, 1).Value Worksheets("Sheet2").Cells(newrow, 2).Value = W…

Accepted Answer

This is what I was suggesting. This code sample is based on the above sample data. If the structure of the sample changes then you will have to amend the code accordingly. I have commented the code so that you shouldn't have a problem understanding it. But if you do, simply post back :)

CODE

```
Option Explicit

Sub Sample()
    '~~> Input/Output Sheets
    Dim wsI As Worksheet, wsO As Worksheet
    Dim Lrow As Long, ORow As Long, i As Long
    Dim rngToFilter As Range

'~~> Set the input, output sheets
    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet2")

'~~> Set the output row in the new sheet
    ORow = 1

With wsI
        '~~> Get last row in Col A
        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

'~~> Set your range
        Set rngToFilter = .Range("A1:D" & Lrow)

'~~> Hide Col C to E
        .Range("C:E").EntireColumn.Hidden = True

'~~> Loop through Col B to Col D
        For i = 2 To 4

'~~> Remove any filters
            .AutoFilterMode = False

'~~> Copy Header viz List| aa, List| bb
            Union(.Cells(1, 1), .Cells(1, i)).Copy wsO.Range("A" & ORow)

'~~> Get next empty row
            ORow = ORow + 1

'~~> Filter, offset(to exclude headers) and copy visible rows
            With rngToFilter
                .AutoFilter Field:=i, Criteria1:="<>"

'~~> Copy the filtered results to the new sheet
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsO.Range("A" & ORow)
            End With

ORow = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1

'~~> Unhide/Hide relevant columns
            .Columns(i).EntireColumn.Hidden = True
            .Columns(i + 1).EntireColumn.Hidden = False

'~~> Remove any filters
            .AutoFilterMode = False
        Next i

'~~> Unhide all columns
        .Range("B:E").EntireColumn.Hidden = False
    End With
End Sub
```

SCREENSHOT

Creating an Excel Macro to populate values

Solution

Problem