Transpose Function..Empty Cells and Characters

[chrisscotty]

Hello All,

I just recently switched to Excel 2007 and am not that familiar with the program.

I have a question that has 3 components.


I have alot of data in Column A that has many blank cells.

I performed several searches and have still not been able to remove them.

This particular method worked if I was selecting a small amount of data

http://www.tech-recipes.com/rx/2189/excel_2007_eliminate_blank_rows/

Yet when I use with the entire list I get the error "selection is too large".


What I basically want to do is take the data that I have gathered and transpose it so I can save as a csv file and import in to my contact manager.


The data looks like this:
NEXT ENTRY
" "




Mr. Rene Reynolds

Chapters: Philadelphia
Position/Title: Machinist
Company: ABC Limited

71 Maybrook Drive
Philadelphia, PA 19118, USA
Bus. Telephone: (215) 298-8108x265
Fax: (215) 298-3545
E-mail: rene.reynolds@abc.com
NEXT ENTRY
" "






Ms Carol Jones

Chapters: Ottawa
Position/Title: Benefits Administrator

28 Reeds Road
North Bay, ON K9J 0K4, CANADA
E-mail: c_jones@yahoo.com
NEXT ENTRY


Mr Billl Jones

Chapters: Binghampton
NEXT ENTRY

----------

So each name after "Next ENTRY" is a new entry and I want the data transposed

Now, all this is consistent as far as the order..name, chapter, postion etc.

The thing is not all names have all the information some just have the name and phone, name and chapter etc etc.

Mr. Rene Reynolds

Chapters: Philadelphia
Position/Title: Machinist
Company: ABC Limited

71 Maybrook Drive
Philadelphia, PA 19118, USA
Bus. Telephone: (215) 298-8108x265
Fax: (215) 298-3545
E-mail: rene.reynolds@abc.com

So..first I want to get rid of all the empty cells and move up and then transpose the data and have it correspond to each entry and if it missing a fied it just skips over.

Oh and one more thing =-)

There appears a little question mark that I can not delete. Some of them appear before the name and some of them appear under NEXT ENTRY and appear as " " when I paste data from excel in to a txt file.

Any help would be greatly appreciated.

 

[Legacy 68668]

Any possibility to have more than 255 characters in one field ?
Like address.?
if so
Change

ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a

to

With ThisWorkbook.Sheets(1).Cells(1)
    For i = 1 To n
        For ii = 1 To t
            .Cells(i, ii).Value = a(i, ii)
    Next ii, i
End With

 

[chrisscotty]

Now it put the first just the two names entries across a to q

next entry bill adams thornhill abc company


Here is the code used
Sub test()
Dim fn As String, temp As String, n As Long, t As Long, a()
fn = "c:\test\aaa.txt" '<- File path
temp = Space(FileLen(fn))
Open fn For Binary As #1
Get #1, , temp
Close #1
temp = "NEXT ENTRY" & vbCrLf & temp
ReDim a(1 To 10000, 1 To 50)
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In Split(temp, vbCrLf)
If e <> "" Then
If UCase(e) = "NEXT ENTRY" Then
n = n + 1
End If
If n > 0 Then
x = Split(e, ":")
If UBound(x) > 0 Then
If Not .exists(x(0)) Then
t = t + 1: a(1, t) = x(0): .Add x(0), t
End If
a(n, .Item(x(0))) = x(1)
Else
If Not .exists("Address") Then
t = t + 1
.Add "Address", t
End If
a(n, .Item("Address")) = a(n, .Item("Address")) & _
IIf(a(n, .Item("Address")) = "", "", " ") & e
End If
End If
End If
Next
End With
With ThisWorkbook.Sheets(1).Cells(1)
For i = 1 To n
For ii = 1 To t
.Cells(i, ii).Value = a(i, ii)
Next ii, i
End With
End Sub

 

[Legacy 68668]

try this

Sub test()
Dim fn As String, temp As String, n As Long, t As Long, flg As Boolean
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
fn = "c:\test\aaa.txt"    
temp = "NEXT ENTRY" & _
      CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If e <> "" Then
            If n > 0 Then
                x = Split(e, ":")
                If UBound(x) > 0 Then
                    If Not .exists(x(0)) Then
                        t = t + 1 : a(1, t) = x(0) : .add x(0), t
                    End If
                    a(n, .item(x(0))) = x(1)
                Else
                    If flg Then
                        b(n, 1) = e : flg = False
                    Else
                        If Not .exists("Address") Then
                            t = t + 1
                            .Add "Address", t
                        End If
                        a(n, .item("Address")) = a(n, .item("Address")) & _
                            IIf(a(n, .item("Address")) = "", "", " ") & e
                    End If
                End If
            End If
        End If
        If UCase(e) Like "*NEXT ENTRY*" Then
            n = n + 1 : flg = True
        End If
    Next
End With
ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a
End Sub

 

[chrisscotty]

Received this error

Compile Error:

Sub or Function not defined.


"a(1, t) =" was also highlighted...

 

[Legacy 68668]

try

Sub test()
Dim fn As String, temp As String, n As Long, t As Long, flg As Boolean, a()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
fn = "c:\test\aaa.txt"    
temp = "NEXT ENTRY" & _
      CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
ReDim a(1 To Rows.Count, 1 To 20)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If e <> "" Then
            If n > 0 Then
                x = Split(e, ":")
                If UBound(x) > 0 Then
                    If Not .exists(x(0)) Then
                        t = t + 1 : a(1, t) = x(0) : .add x(0), t
                    End If
                    a(n, .item(x(0))) = x(1)
                Else
                    If flg Then
                        b(n, 1) = e : flg = False
                    Else
                        If Not .exists("Address") Then
                            t = t + 1
                            .Add "Address", t
                        End If
                        a(n, .item("Address")) = a(n, .item("Address")) & _
                            IIf(a(n, .item("Address")) = "", "", " ") & e
                    End If
                End If
            End If
        End If
        If UCase(e) Like "*NEXT ENTRY*" Then
            n = n + 1 : flg = True
        End If
    Next
End With
ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a
End Sub

 

[chrisscotty]

Same Error except:

b(n, 1) = was highlighted this time>


Some of the position titles are quite long, but on the same line, not sure if that would make a difference...

 

[chrisscotty]

When I try to do it again I get:

Can't execute in break mode:

 

[Legacy 68668]

Same Error except:

b(n, 1) = was highlighted this time>


Some of the position titles are quite long, but on the same line, not sure if that would make a difference...

That should be a

a(n, 1) =

If you are in the break mode then click on the square shaped button Stop button) located below the menu bar.

 

[chrisscotty]

We are definitely getting somewhere!

This time it worked well in that it transposed all the data.

The data also seemed to be aligned/correspond for the random several names I checked.


Problems:

1. A large percentage of the entries do not include the name.

2. Alot of the entries have NEXT ENTRY as the name .and then only list part of the data.


I think I did point out that although the data is consistent in that

Mr. Rene Reynolds

Chapters: Philadelphia
Position/Title: Machinist
Company: ABC Limited

71 Maybrook Drive
Philadelphia, PA 19118, USA
Bus. Telephone: (215) 298-8108x265
Fax: (215) 298-3545
E-mail: rene.reynolds@abc.com
NEXT ENTRY

Now, all this is consistent as far as the order..name, chapter, postion etc.

The thing is not all names have all the information some just have the name and phone, name and chapter etc etc.

Such as :

Ms Carol Jones

Chapters: Ottawa
Position/Title: Benefits Administrator

28 Reeds Road
North Bay, ON K9J 0K4, CANADA

NEXT ENTRY


Mr Billl Jones

Chapters: Binghampton
NEXT ENTRY


I was combing through the text file and I notice one aberration:

There are a 100 or so that also have



"Chapter Title: " under chapter so look like


Mr. Rene Reynolds

Chapter Title: Program Coordinator
Chapters: Philadelphia

Position/Title: Machinist
Company: ABC Limited

71 Maybrook Drive
Philadelphia, PA 19118, USA
Bus. Telephone: (215) 298-8108x265
Fax: (215) 298-3545
E-mail: rene.reynolds@abc.com
NEXT ENTRY

Sorry, just noticed that.

So I can go through the list and delete that field unless you have an easy fix to include.

Thanks !!!

 

[Legacy 68668]

This is a brief explanation;

1) Read all the text from a Text file
2) Split 1) into each line
3) Each time "NEXT ENTRY" was find, add new row in the result and put next none blank row to Name field.
4) if the line incl. ":", like something1:something2, something1 becomes a header and something2 will be actual data in corresponding columns header.
5) if not 4) then all the lines will be combined to "Address" field.

Is that correct ?