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]

Sub test()
Dim fn As String, temp As String, n As Long, t As Long, a()
fn = "c:\test\test.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
ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a
End Sub

 

[Legacy 68668]

fn = "c:\test\test.txt"

You need to change the file path to your actual file path.

 

[chrisscotty]

I created the same file path that you gave me assuming it was the temp output for the data..my fault ... text.txt file.


So I changed the path to the name of the actual file I am working in and titled text2.xlsx

It did remove alot of the empty cells:

Here is the code:

Sub test()
Dim fn As String, temp As String, n As Long, t As Long, a()
fn = "c:\test\test2.xlsx" '<- 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
ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a
End Sub
-----------------

It also inserted this at the top from c to z.

"2Û°˜\¿™mX'º(ŽŽFuºa1'¸
w$¿a1'¸~;’ß°˜Ü<;’ß°l'e¸v$¿aÙNôº…ßtt„¶aÙN
1¨.Éê–íbµ°.FF'~öÕ½w%HmuŸ®íž*ZÌNèM´îU=œüen(•èBÎÃÉ^~(Ôí.ÔåˆGh«ïÉR3x
#´Õ½Nî„åuº""ˆæ7•WÐ5~85mu�ÏÑ’zjÚvƒ¶šÖèéÞ
ìÎ9¿üX¢òøèá|ùSð
'ŽlÕNE(±íIb«›
qb�ÙöeÙ)@zÌÂFˆ)l×¼pAd«b–GC–N#Èl{b¶ºb‘‡ÓˆÉtëXEfÛ³-ØDGÜ–=9Å€*J·g•.¿…êlÃòmÆ?z·�£ŠÄ¶'b[`ߎÄ6,ß–¨MÑz@ê&°U¤ñÛ�ŽÄ6,Ö>‘`i…žˆ*î®ä�Åtd*ÝÕ^ˆ}»aß"

 

[Legacy 68668]

It is reading from the TEXT file, not the Excel file.

So the file path should be targeted at the original TEXT file, not xls(x)...

 

[chrisscotty]

"2Û°˜\¿™mX'º(ŽŽFuºa1'¸
w$¿a1'¸~;’ß°˜Ü<;’ß°l'e¸v$¿aÙNôº…ßtt„¶aÙN
1¨.Éê–íbµ°.FF'~öÕ½w%HmuŸ®íž*ZÌNèM´îU=œüen(•èBÎÃÉ^~(Ôí.ÔåˆGh«ïÉR3x
#´Õ½Nî„åuº""ˆæ7•WÐ5~85mu�ÏÑ’zjÚvƒ¶šÖèéÞ
ìÎ9¿üX¢òøèá|ùSð
'ŽlÕNE(±íIb«›
qb�ÙöeÙ)@zÌÂFˆ)l×¼pAd«b–GC–N#Èl{b¶ºb‘‡ÓˆÉtëXEfÛ³-ØDGÜ–=9Å€*J·g•.¿…êlÃòmÆ?z·�£ŠÄ¶'b[`ߎÄ6,ß–¨MÑz@ê&°U¤ñÛ�ŽÄ6,Ö>‘`i…žˆ*î®ä�Åtd*ÝÕ^ˆ}»aß"

 

[Legacy 68668]

then reverse those parts back to the original

Can you change

temp = "NEXT ENTRY" & _
      CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll

to

temp = Space(FileLen(fn))
Open fn For Binary As #1
    Get #1, , temp
Close #1
temp = "NEXT ENTRY" & vbCrLf & temp

And make sure that your fn should look like "........txt", not "....xslx"

 

[chrisscotty]

"2Û°˜\¿™mX'º(ŽŽFuºa1'¸
w$¿a1'¸~;’ß°˜Ü<;’ß°l'e¸v$¿aÙNôº…ßtt„¶aÙN
1¨.Éê–íbµ°.FF'~öÕ½w%HmuŸ®íž*ZÌNèM´îU=œüen(•èBÎÃÉ^~(Ôí.ÔåˆGh«ïÉR3x
#´Õ½Nî„åuº""ˆæ7•WÐ5~85mu�ÏÑ’zjÚvƒ¶šÖèéÞ
ìÎ9¿üX¢òøèá|ùSð
'ŽlÕNE(±íIb«›
qb�ÙöeÙ)@zÌÂFˆ)l×¼pAd«b–GC–N#Èl{b¶ºb‘‡ÓˆÉtëXEfÛ³-ØDGÜ–=9Å€*J·g•.¿…êlÃòmÆ?z·�£ŠÄ¶'b[`ߎÄ6,ß–¨MÑz@ê&°U¤ñÛ�ŽÄ6,Ö>‘`i…žˆ*î®ä�Åtd*ÝÕ^ˆ}»aß"

this was in response to the original post with the garbled data...

 

[Legacy 68668]

That's almost impossible...
Can you show me the line of

fn = ...
?

and is it really a .txt file ?

 

[chrisscotty]

What I was saying was the garbled data was the result of me using the xlsx extension instead of the source text file which was obviously my fault.

So the output data had the garbled characters


I need to find and replace some data in the original text file as I had changed some of the data via "find and replace" through excel, a my computer would crash when I used wordpad.

I will do that and post tommorow.

Thanks again for all your work !

 

[chrisscotty]

Excel hanged and then got an error code of: "400" in Visual Basic editor.


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
ThisWorkbook.Sheets(1).Cells(1).Resize(n, t).Value = a
End Sub