Convert Column to Row if Cell Not Empty

1
votes

Need some help with a VBA script for excel to convert data in a column into a new Row if certain column not empty. Duplicate the initial data in a couple of primary columns into a new row and copy/condense the data from another column into that new row if the cell in the column is not empty. My file has 1,000's of records and I don't have the time to individually separate them. Best if seen visually below (sorry not enough rep to post image)

Starts like this.

Col1.......Col2.....Col3.....Col4
ItemA.....$2.........................
ItemB.....$2........$4.............
ItemC.....$6.........................
ItemD.....$2........$3.........$5
ItemE.....$9.........................

Finish like this

Col1.......Col2
ItemA.....$2
ItemB.....$2
ItemB.....$4
ItemC.....$6
ItemD.....$2
ItemD.....$3
ItemD.....$5
ItemE.....$9

This is how I would handle in vb and html with recordset loops. Just need advice on excel where recordset or range is determined and how it starts through columns.

Dim Col1, Col2, Col3, Col4, RowData, CondenseData, FinalData

FinalData = ""

While ((RS.Items__numRows <> 0) AND (NOT RS.Items.EOF))  'recordset loop how in Excel?

CondenseData = ""
Col1 = RS.Col1Data 'how to go from column to column in row in excel?
Col2 = RS.Col2Data
Col3 = RS.Col3Data
Col4 = RS.Col4Data

If Not IsNull(Col2) Then
CondenseData = Col1 & ", " & Col2
RowData = CondenseData & "<br />" ' create a new row with the revised data if not empty?
End If
If Not IsNull(Col3) Then
CondenseData = Col1 & ", " & Col3
RowData = CondenseData & "<br />"
End If
If Not IsNull(Col4) Then
CondenseData = Col1 & ", " & Col4
RowData = CondenseData & "<br />"
End If

FinalData = FinalData & RowData

  RS.Items__index=RS.Items__index+1
  RS.Items__numRows=RS.Items__numRows-1
  RS.Items.MoveNext()

Wend
3
excelvba
Welcome to SO! Reading how to ask a good question will get you an answer sooner. Remember, this isn't a code-writing service, so post what you've got & we can help you fix it. If you don't know where to start, try using the Macro Recorder. – FreeMan
I hear you on not a code service. I can do this in my sleep with VB and html via a recordset loop and if then statements or even a for statement, but I can't figure out how to create a "recordset" (I know it is a range) in excel. or to go to next record. I can easily post vb portion if that helps. – Brewy

3 Answers

1
votes

In VBA we use Ranges instead of Recordsets. They are somewhat kind of-ish the same-ish kind of... But anyway.. you can kind of think of it as a recordset if that helps. It's just there is really no relationship across records/rows and fields/columns like there would be in a recordset.

Anyhow, an example of how to go about this

Sub example()
    Dim rngToConvert as Range
    Dim rngRow as Range
    Dim rngCell as Range

    'write this out to a new tab so we need incrementer to keep track of rows
    Dim writeRow as integer
    writeRow = 1

    'The entire range we are converting
    Set rngToConvert = Sheets("yoursheetname").Range("A1:Z1000")

    'Loop through each row
    For each rngRow in rngToConvert.Rows

        'Loop through each cell (field)
        For each rngCell in rngRow.Cells

            'ignore that first row since that has your "ItemA", "ItemB", etc..
            'Also ignore if it doesn't have a value
            If rngCell.Column > 1 And rngCell.Value <> "" Then

                'Write that row header
                Sheets("SheetYouAreWritingOutTo").Cells(writeRow, 1).value = rngRow.Cells(1,1)

                'Write this non-null value
                Sheets("SheetYouAreWritingOutTo").Cells(writeRow, 2).value = rngCell.Value

                'Increment Counter
                writeRow = writeRow + 1 
            End if
        Next rngCell
    Next rngRow
End sub

There's probably a faster way to go about it that doesn't require excel to iterate through every single cell in the range, but this is fast and dirty and will do the job. Apologies if I messed up the syntax anywhere. I wrote it on the fly in notepad.

0
votes

I took your example data and created this code. I tested it and it works. I pass in a parameter with the number of rows rather than obtain that from the source sheet. You can tweak that if need be to make it fully dynamic. 

  Sub FormatSheet(aRowCount As Integer)
      Dim iSheet2Row As Integer
    iSheet2Row = 1

    For i = 1 To aRowCount
        Dim bHasData As Boolean
        bHasData = True

        Dim iCol As Integer
        iCol = 1

        Do While bHasData
           Dim varColHeader As String

           If Len(Trim(Cells(i, iCol).Value)) > 0 Then

             If iCol = 1 Then
                  'get col header value
                  varColHeader = Cells(i, 1)
              Else
                 'write col header
                  Worksheets("Sheet2").Cells(iSheet2Row, 1).Value = varColHeader
                          'write col data
                  Worksheets("Sheet2").Cells(iSheet2Row, 2).Value = Worksheets("Sheet1").Cells(i, iCol).Value
                iSheet2Row = iSheet2Row + 1
              End If
          Else
                  bHasData = False
          End If

          iCol = iCol + 1
         Loop

    Next i

End Sub
0
votes

The following will work, and is extremely fast. 

Public Sub Condense(rIn As Range, rOut As Range)

    Dim v As Variant, vOut As Variant
    Dim i As Long, j As Long, c As Long

    v = rIn.Value2
    ReDim vOut(1 To UBound(v, 1) * UBound(v, 2), 1 To 2)

    For i = 1 To UBound(v, 1)
        For j = 2 To UBound(v, 2)
            If Len(v(i, j)) Then
                c = c + 1
                vOut(c, 1) = v(i, 1)
                vOut(c, 2) = v(i, j)
            End If
        Next
    Next        
    rOut.Resize(c, 2) = vOut

End Sub