Link to home
Start Free TrialLog in
Avatar of Rick Norris
Rick Norris

asked on

Conversion unformatted to formatted Excel


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!

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

Avatar of Patrick Matthews
Patrick Matthews
Flag of United States of America image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Rick Norris
Rick Norris



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.


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.


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
                    RecordNum = RecordNum + 1
                End If
        End Select
    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)
    End With
    MsgBox "Done"
End Sub

Open in new window


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