Avatar of Rick Norris
Rick Norris
 asked on

Conversion unformatted to formatted Excel

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
Microsoft Excel

Avatar of undefined
Last Comment
Rick Norris

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Patrick Matthews

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Rick Norris

ASKER
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
Patrick Matthews

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

Rick Norris

ASKER
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
Your help has saved me hundreds of hours of internet surfing.
fblack61