Trying to flatten a file 1

[Welshbird]

We have a legacy buit of software that chucks out data for us, but in a really unusable format. So, I thought with my new-found VBA skill I might just have a go at creating an ADD-IN to help us out.

*Sigh*

So, my data can have up to 6 levels of extract, and each new level still appears in Column A, but with differing numbers of Spaces before the beginning of the data.

This makes more sense if I show you:
[tt]
Region1
Area1
Area2
Product1
[/tt]etc....

So, I made some code all of my own that asked the user for the number of columns, and then inserts columns and moves the data over.
Which works, in as far as it does sorta work.... but nowe I have muchas gaps all over the place and am not really sure I'm doing this in the best way.
My output now shows the following in columns A:B:C
[tt]
Region1
Area1
Area2
Product1
[/tt]
when what I really need is more like this in columns A:B:C
[tt]
Region1
Region1 Area1
Region1 Area1 Product1
Region1 Area2
Region1 Area2 Product1
[/tt]
The remaining gaps are total rows innit.

the code I have so far is this:

Private Sub cmdOK_Click()
'First set up some standard figures to use
Dim DataCols As Integer
DataCols = cmbDataRows.Value    'Number of descriptive columns in final flat file
Dim DataRows As Long
DataRows = ActiveSheet.UsedRange.Rows.Count     'Number of columns with data (saves looping through empty ones!)
'NB: No error checking for popluated column headings, as you may just not want them....
'Then insert the correct number of columns
Select Case DataCols
Case 1
MsgBox "Data only has one row option so cannot be flattened further."
Case 2
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Case 3
Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Case 4
Columns("B:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Case 5
Columns("B:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Case 6
Columns("B:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Select
'Now to move data around
Dim rwIndex As Integer
    For rwIndex = 2 To DataRows
    If Left(Cells(rwIndex, 1).Value, 13) = "             " Then Cells(rwIndex, 1).Cut Destination:=Cells(rwIndex, 6)
    If Left(Cells(rwIndex, 1).Value, 11) = "           " Then Cells(rwIndex, 1).Cut Destination:=Cells(rwIndex, 5)
    If Left(Cells(rwIndex, 1).Value, 9) = "         " Then Cells(rwIndex, 1).Cut Destination:=Cells(rwIndex, 4)
    If Left(Cells(rwIndex, 1).Value, 7) = "       " Then Cells(rwIndex, 1).Cut Destination:=Cells(rwIndex, 3)
    If Left(Cells(rwIndex, 1).Value, 5) = "     " Then Cells(rwIndex, 1).Cut Destination:=Cells(rwIndex, 2)
    Next rwIndex
'not a huge help unless we can fill in the blanks!

Unload Me
End Sub

where cmbDataRows is the number chosen by the user from a combo.

Any thoughts of the best way I should be tackling this?


Fee

"The cure for anything is salt water – sweat, tears, or the sea." Isak Dinesen

 

[SkipVought]

hi,

1) insert a sheet AFTER the sheet that has the imported column of data.

2) assuming that your imported data is in column a, starting in row 1...

Sub test2()
    Dim r As Range, iCol As Integer, ws As Worksheet
    
    Set ws = Sheets(ActiveSheet.Index + 1)
    
    For Each r In Range([A1], [A1].End(xlDown))
        With r
            iCol = (Len(.Value) - Len(Trim(.Value)) + 1) / 2 - 1
            ws.Cells(.Row, iCol).Value = Trim(.Value)
        End With
    Next
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Welshbird]

Oooooo I'll have a go. Thanks Skippy.

Fee

"The cure for anything is salt water – sweat, tears, or the sea." Isak Dinesen

 

[SkipVought]

Just realized that my code does not propagate the values down. Stand by!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Sub test2()
    Dim r As Range, iCol As Integer, ws As Worksheet, i As Integer
    
    Set ws = Sheets(ActiveSheet.Index + 1)
    
    For Each r In Range([A1], [A1].End(xlDown))
        With r
            iCol = (Len(.Value) - Len(Trim(.Value)) + 1) / 2 - 1
            ws.Cells(.Row, iCol).Value = Trim(.Value)
            If iCol > 1 Then
                For i = 1 To iCol - 1
                    With ws.Cells(.Row, i)
                        .Value = .Offset(-1).Value
                    End With
                Next
            End If
        End With
    Next
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Welshbird]

I'm going to try right now!

Fee

"The cure for anything is salt water – sweat, tears, or the sea." Isak Dinesen

 

[Welshbird]

I'm having a day of AARRGG!!!!! here trying to het other things to work, so will be coming back to this tomorrow.

Thanks for this though.

Fee

"The cure for anything is salt water – sweat, tears, or the sea." Isak Dinesen

 

[Welshbird]

Wowe. Just wow - does exactly what I need.

I'm going to try and work out exactly how - but thank you so much!

Fee

"The cure for anything is salt water – sweat, tears, or the sea." Isak Dinesen