Changing flat file to relational in excel

Coaster_brook_trout used Ask the Experts™
I would like a macro to change sheet 1 to sheet 2. I don't have the first clue on how to write a macro, I am doing all of this by hand. Basically I am turning the flat file onto its side.
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2008

I could have an add-in for this. Select cell E2 and run attached the Table2DB add-in with all default options. This turns the flat file on the side, but I'm not sure if you have added logic cause my result is different than yours and I don't understand the data fully.



So that is awesome, but it's not doing what I need because it needs to grab the i1 and the n1 together, they go's only grabbing the i1. The other issue is, I don't need the i1 unless there is an n1 after it. If there is no n1 after the i1, I consider that a null value....
Top Expert 2008
OK, new code for you:

Sub flatten()
Dim lColLoop As Long, lRowLoop As Long, lLastRow As Long, lTargetRow As Long
Dim shtDest As Worksheet, shtOrg As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set shtOrg = ActiveSheet
Set shtDest = Sheets.Add
lTargetRow = 2

With shtOrg

    .Cells(1, 1).Resize(1, 4).Copy shtDest.Cells(1, 1)
    shtDest.Cells(1, 5) = "Inch Group"
    shtDest.Cells(1, 6) = "N"

    lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For lRowLoop = 2 To lLastRow
        For lColLoop = 6 To 44 Step 2
            If Len(.Cells(lRowLoop, lColLoop)) > 0 Then
                .Cells(lRowLoop, 1).Resize(1, 4).Copy shtDest.Cells(lTargetRow, 1)
                .Cells(lRowLoop, lColLoop).Offset(0, -1).Resize(1, 2).Copy shtDest.Cells(lTargetRow, 5)
                lTargetRow = lTargetRow + 1
            End If
        Next lColLoop
    Next lRowLoop
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub

Open in new window



I wish I could give out more points, this was the most excellent solution and it came so quickly and will save me hours of work everyday!!!!


Thanks Thomas!!!!
Top Expert 2008

Glad to help. Thanks for the kind words.


Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial