PDA

View Full Version : [SOLVED] Clean and Trim Text from Download



zljordan
11-06-2014, 11:13 AM
Hi All,I am in need of a macro that can clean and trim the text that it represented in column A of the attached file. For some reason when I download a file from this specific website, the data populates in a wrapped form and does not allow me to perform any edits via text formulas. Any help that you can provide is greatly appreciated! Thank you!

Kenneth Hobs
11-06-2014, 12:26 PM
Clean and trim how? What text edit causes a problem?

You can easily change the wrapped text format by clicking the column heading, Ctrl+1, and setting the Alignment for wrapped text to off.

zljordan
11-06-2014, 12:34 PM
All of the words are on different lines within the same cell, so even when text wrap is taken off, the text formulas that I try and run are returning an error.
http://www.vbaexpress.com/forum/attachment.php?attachmentid=12484&stc=1

westconn1
11-08-2014, 03:31 AM
your text in column A contains chr(10) which is line feed, one or more and multiple chr(160) which i believe represent non-breaking spaces
you can use replace to remove these characters, by replacing them with a suitable substitute or nothing

YasserKhalil
11-08-2014, 04:26 AM
Try this code

Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 2005-09-29 join.htm
'-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
' - Optionally reenable improperly terminated Change Event macros
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub



Select Column A first and apply the code

westconn1
11-08-2014, 03:15 PM
you can test this to see if it does as your require, test on copy of data first

For Each cel In Range("A:A")
If IsEmpty(cel) Then Exit For ' finish on empty cell
cel.Value = Replace(Replace(cel, Chr(10), " "), Chr(160), "")
Next

YasserKhalil
11-08-2014, 03:23 PM
Mr. westconn (http://www.vbaexpress.com/forum/member.php?2465-westconn1)
Very good code I tested it. I think it is perfect

zljordan
11-10-2014, 09:32 AM
Thank you very much for all of your help. I really appreciate it! Your code has worked beautifully. Again, I cannot thank you enough!!