Question

I’m hoping that I can explain this well enough.
I have an excel document which has been laid out as such;

     A      B      C      D     ...     n
1 [     ][  H  ][  H  ][  H  ][ ... ][  H  ]
2 [     ][  T  ][  T  ][  T  ][ ... ][  T  ]
3 [  C  ][  D  ][  D  ][  D  ][ ... ][  D  ]
4 [  C  ][  D  ][  D  ][  D  ][ ... ][  D  ]
5 [  C  ][  D  ][  D  ][  D  ][ ... ][  D  ]
. [ ... ][ ... ][ ... ][ ... ][ ... ][  D  ]
n [  C  ][  D  ][  D  ][  D  ][  D  ][  D  ]

H: Major header
T: Title
C: Side Header
D: Data (Some may also be blank)

I need to convert this into a format that can be utilised by a database. I know what I want to convert it to, but I do not know how to do it (with vba or any other alternative).
What I would like is;

     A      B      C      D
1 [  C  ][  T  ][  H  ][  D  ]
2 [  C  ][  T  ][  H  ][  D  ]
3 [  C  ][  T  ][  H  ][  D  ]
. [ ... ][ ... ][ ... ][ ... ]
n [  C  ][  T  ][  H  ][  D  ]

How I think it could be done is to loop through the viable region (all of the ‘Data’ represented as ‘D’), checking to make sure that is contains data in it (if not do not print that line), and then getting its respective headers and printing out the end products, either by overwriting the previous data or putting it onto a different sheet.

Thanks! Any help is appreciated.

Answer 1

here is a full working code (in my sample at least):

Option Explicit

Sub convert_for_DB()
Dim lLastRow As Long, lLastCol As Long
Dim c As Range
Dim index As Long
Dim aH As Variant, aT As Variant, aC As Variant
Dim vValues() As Variant

With Worksheets("Sheet1")
    'find the last row and the last col
    lLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    'get the headers
    aH = .Range("B1", .Cells(1, lLastCol)).Value
    aT = .Range("B2", .Cells(2, lLastCol)).Value
    aC = .Range("A3", .Cells(lLastRow, 1)).Value
    'create an array with the number of values
    ReDim vValues((lLastRow - 2) * (lLastCol - 1), 3)

    index = 0
    'parse every value of the array
    For Each c In .Range("B3", .Cells(lLastRow, lLastCol))
        If Len(c.Value) > 0 Then
            vValues(index, 0) = aC(c.Row - 2, 1)
            vValues(index, 1) = aH(1, c.Column - 1)
            vValues(index, 2) = aT(1, c.Column - 1)
            vValues(index, 3) = c.Value
            index = index + 1
        End If
    Next c
End With

'store back the data to another sheet
With Worksheets("Sheet2")
    .Range("A1", .Cells(UBound(vValues, 1), 4)) = vValues
End With
End Sub