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.

 

[chrisscotty]

Actually the name does appear once in the code..my bad..

The thing is the first time around the name did show up alongside the street,postal,country. and I have not changed the source text file.

The name is still not showing at all and now under chapters the city and postal show up

 

[Legacy 68668]

Again, I need you to find out what's in blank cell in Col.A...

Can you try

=Code(A1)
in any cell ? where A1 should be the blank cell in col.A, so it could be A2, A3, A4 ... any blank cell in col.A

 

[Legacy 68668]

OOps
should try <3, Not >3

                    If flg Then
                        a(n, 1) = e: flg = Len(e) < 3
                    Else

 

[chrisscotty]

I am not seeing any empty cells in column A.

I pasted =CODE(A1) in the formula bar which erased the first cell and got a "circular reference warning"

I proceeded to run it and it inserted a 0 in the first cell.

 

[Legacy 68668]

I am not seeing any empty cells in column A.

I pasted =CODE(A1) in the formula bar which erased the first cell and got a "circular reference warning"

I proceeded to run it and it inserted a 0 in the first cell.

??
Are all the names there ?

 

[chrisscotty]

Everything is perfect again...except no names and no column for names.


Everything else is where it should be.

Sub test()
Dim fn As String, temp As String, n As Long, t As Long, flg As Boolean, a()
Dim x, y
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
fn = "c:\test\aaa.txt"
temp = "NEXT ENTRY" & _
CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
temp = CleanTxt(temp)
ReDim a(1 To Rows.Count, 1 To 20)
n = 1: a(n, 1) = "Name"
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In Split(temp, vbCrLf)
If (Trim(e) <> "") * (Not e Like "*NEXT ENTRY*") Then
If n > 1 Then
x = Split(e, ":")
If UBound(x) > 0 Then
If Not .exists(x(0)) Then
t = t + 1: a(1, t) = x(0): .Item(x(0)) = t: a(1, t) = x(0)
End If
a(n, .Item(x(0))) = x(1)
Else
If flg Then
a(n, 1) = e: flg = Len(e) < 3
Else
If InStr(e, ",") < 1 Then
If Not .exists("Address") Then
t = t + 1: a(1, t) = "Address"
.Item("Address") = t
End If
a(n, .Item("Address")) = e
Else
y = Split(e, ",")
If Not .exists("State") Then
t = t + 1: .Item("State") = t: a(1, t) = "State"
End If
If Not .exists("Zip") Then
t = t + 1: .Item("Zip") = t: a(1, t) = "Zip"
End If
If Not .exists("Country") Then
t = t + 1: .Item("Country") = t: a(1, t) = "Country"
End If
a(n, .Item("Zip")) = y(0)
If UBound > 0 Then a(n, .Item("State")) = y(1)
If UBound > 1 Then a(n, .Item("Country")) = y(2)
End If
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

Function CleanTxt(ByVal txt As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "^\s*$"
.Global = True
.MultiLine = True
CleanTxt = .Replace(txt, "")
End With
End Function

 

[Legacy 68668]

A1 should be "Name", column header.
Still nothing in col.A ?

 

[chrisscotty]

A is the Chapters: column.

So right now the only thing that is missing is the Name Column with the names.

 

[Legacy 68668]

...............................what am I doing....

n = 1: a(n, 1) = "Name"

should be

n = 1: t = 1 : a(n, t) = "Name"

 

[chrisscotty]

YES !!!!!!!!


Thanks Alot !