Conversion unformatted to formatted Excel

Rick Norris
Rick Norris used Ask the Experts™
on
Experts:

I have attached an excel spreadsheet.  The tab labeled "Raw Data" is just a 5 company representation of a list that I have that contains approximately 6000 entries.  Entries on the Raw Data tab appear to all be formatted the same way, except for the occasional inclusion of a website address.

I have copied and pasted on the tab labeled "FormatNeeded" to indicate what I would like the end product to look like.  Next step (I can handle) would be to push the data in the "formatNeeded" tab to an access database for further use.

I know it is obvious; the order of the columns in the "FormatNeeded" tab does not matter.

Your assistance will be greatly appreciated!

Thanks,
Rick D Norris, CPA/CFE
Conrad, Burnett, Norris and Gordon, LLC

ListToConvert.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010
Commented:
This appears to work for me.  I took the liberty of breaking out city, state, and ZIP separately: since you're putting this in Access, you'll want that atomicity to support queries.


Sub Reformat()
    
    Dim LastR As Long, r As Long
    Dim ArrayIn As Variant
    Dim ArrayOut() As Variant
    Dim DestWs As Worksheet
    Dim Entries As Long
    Dim RecordNum As Long
    Dim CityStZIP As String
    
    With ThisWorkbook.Worksheets("RawData")
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        ArrayIn = .Range("a1:b" & LastR).Value
    End With
    
    For r = 1 To LastR
        If Entries = 0 Then
            ReDim ArrayOut(1 To 15, 1 To 1) As Variant
            Entries = 1
            RecordNum = 1
        End If
        Select Case RecordNum
            Case 1
                ArrayOut(10, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                RecordNum = RecordNum + 1
            Case 2 To 6
                ArrayOut(RecordNum - 1, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                RecordNum = RecordNum + 1
            Case 7
                CityStZIP = Trim(Replace(ArrayIn(r, 1), Chr(160), ""))
                ArrayOut(7, UBound(ArrayOut, 2)) = Left(CityStZIP, Len(CityStZIP) - 9)
                ArrayOut(8, UBound(ArrayOut, 2)) = Mid(CityStZIP, Len(CityStZIP) - 7, 2)
                ArrayOut(9, UBound(ArrayOut, 2)) = Right(CityStZIP, 5)
                RecordNum = RecordNum + 1
            Case 8
                If LCase(ArrayIn(r, 1)) <> "company information" Then
                    ArrayOut(6, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                End If
                RecordNum = RecordNum + 1
            Case Else
                If LCase(ArrayIn(r, 1)) = "primary sic" Then
                    ArrayOut(11, UBound(ArrayOut, 2)) = ArrayIn(r, 2)
                    ArrayOut(12, UBound(ArrayOut, 2)) = ArrayIn(r + 1, 2)
                    ArrayOut(13, UBound(ArrayOut, 2)) = ArrayIn(r + 2, 2)
                    ArrayOut(14, UBound(ArrayOut, 2)) = ArrayIn(r + 3, 2)
                    ArrayOut(15, UBound(ArrayOut, 2)) = ArrayIn(r + 4, 2)
                    If (r + 5) <= LastR Then
                        Entries = Entries + 1
                        ReDim Preserve ArrayOut(1 To 15, 1 To Entries) As Variant
                        RecordNum = 1
                    End If
                    r = r + 4
                Else
                    RecordNum = RecordNum + 1
                End If
        End Select
    Next
    
    Set DestWs = ThisWorkbook.Worksheets.Add
    
    With DestWs
        .Range("a1").Resize(1, 15).Value = Array("ContactName", "Position", "Telephone", "Email", "Address", _
            "Website", "City", "State", "ZIP", "CompanyName", "PrimarySIC", "PrimarySICDescr", _
            "EmployeeSize", "Sales", "CreditDescr")
        .Range("a2").Resize(Entries, 15).Value = Application.Transpose(ArrayOut)
        .Columns.AutoFit
    End With
    
    MsgBox "Done"
    
End Sub

Open in new window

Author

Commented:
Matthew:

It worked FLAWLESSLY!!   Many Many Thanks!!

Now, I just want to take the time within the next week or so, and try to really UNDERSTAND what you have written!!

Again, awesome work.

Rick
Top Expert 2010

Commented:
Rick,

Glad to help, and even more that you want to understand how it works.  Here is a commented version, which I hope will speed that process along.

Patrick

Sub Reformat()
    
    Dim LastR As Long, r As Long
    Dim ArrayIn As Variant
    Dim ArrayOut() As Variant
    Dim DestWs As Worksheet
    Dim Entries As Long
    Dim RecordNum As Long
    Dim CityStZIP As String
    
    With ThisWorkbook.Worksheets("RawData")
        ' Determine last row with data
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row

        ' Dump the original values into an array--faster processing
        ArrayIn = .Range("a1:b" & LastR).Value
    End With
    
    ' loop through each "row" in the array
    For r = 1 To LastR

        ' If Entries = 0 then we are processing the very first item in array
        If Entries = 0 Then
            ' re-dimension array.  Normally I would do the 1-15 as the 2nd
            ' dimension, but since this will keep getting re-sized, only the
            ' last dimension can be dynamic
            ReDim ArrayOut(1 To 15, 1 To 1) As Variant
            Entries = 1
            RecordNum = 1
        End If

        ' The idea here is that each company will have a number
        ' of lines, which I track here with RecordNum.  The line number
        ' you are on for that company determines what data element is
        ' on that line
        Select Case RecordNum
            Case 1
                ArrayOut(10, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                RecordNum = RecordNum + 1
            Case 2 To 6
                ArrayOut(RecordNum - 1, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                RecordNum = RecordNum + 1
            Case 7
                ' break out city, st, zip to different fields
                CityStZIP = Trim(Replace(ArrayIn(r, 1), Chr(160), ""))
                ArrayOut(7, UBound(ArrayOut, 2)) = Left(CityStZIP, Len(CityStZIP) - 9)
                ArrayOut(8, UBound(ArrayOut, 2)) = Mid(CityStZIP, Len(CityStZIP) - 7, 2)
                ArrayOut(9, UBound(ArrayOut, 2)) = Right(CityStZIP, 5)
                RecordNum = RecordNum + 1
            ' RecordNum = 8 can be either a web site, of the "company info" label
            Case 8
                If LCase(ArrayIn(r, 1)) <> "company information" Then
                    ArrayOut(6, UBound(ArrayOut, 2)) = ArrayIn(r, 1)
                End If
                RecordNum = RecordNum + 1
            ' For any other RecordNum value, we need to find the stuff in Col B
            ' we know how to find it by looking for "primary sic"
            Case Else
                If LCase(ArrayIn(r, 1)) = "primary sic" Then
                    ArrayOut(11, UBound(ArrayOut, 2)) = ArrayIn(r, 2)
                    ArrayOut(12, UBound(ArrayOut, 2)) = ArrayIn(r + 1, 2)
                    ArrayOut(13, UBound(ArrayOut, 2)) = ArrayIn(r + 2, 2)
                    ArrayOut(14, UBound(ArrayOut, 2)) = ArrayIn(r + 3, 2)
                    ArrayOut(15, UBound(ArrayOut, 2)) = ArrayIn(r + 4, 2)
                    ' if we are not at the end of input, we have at least one more
                    ' company to process, so we have to re-size the array
                    If (r + 5) <= LastR Then
                        Entries = Entries + 1
                        ReDim Preserve ArrayOut(1 To 15, 1 To Entries) As Variant
                        RecordNum = 1
                    End If
                    ' usually incrementing the index variable for a For/Next loop
                    ' is a bad idea, but here I did it to force the program to skip
                    ' the next few lines, because we already processed them above
                    r = r + 4
                Else
                    RecordNum = RecordNum + 1
                End If
        End Select
    Next
    
    Set DestWs = ThisWorkbook.Worksheets.Add
    
    With DestWs
        .Range("a1").Resize(1, 15).Value = Array("ContactName", "Position", "Telephone", "Email", "Address", _
            "Website", "City", "State", "ZIP", "CompanyName", "PrimarySIC", "PrimarySICDescr", _
            "EmployeeSize", "Sales", "CreditDescr")

        ' remember that the array was really "rotated": column values were
        ' in 1st dimension.  To get this into the desired output format, we
        ' have to transpose the data
        .Range("a2").Resize(Entries, 15).Value = Application.Transpose(ArrayOut)
        .Columns.AutoFit
    End With
    
    MsgBox "Done"
    
End Sub

Open in new window

Author

Commented:
Matthew:

You have definitely went ABOVE AND BEYOND what I would have ever expected.....

Yes, the commented version will help....  I'm a lot more comfortable in the C# .net world than in VBA.

Thanks once again!!

Rick

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