Changing flat file to relational in excel

Coaster_brook_trout
Coaster_brook_trout used Ask the Experts™
on
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.
Help.xls
Comment
Watch Question

Do more with

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

Commented:
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.

Thomas
Table2DB.xla

Author

Commented:
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 together....it'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
Commented:
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


Thomas

Author

Commented:
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!!!!

Author

Commented:
Thanks Thomas!!!!
Top Expert 2008

Commented:
Glad to help. Thanks for the kind words.

Thomas

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