We help IT Professionals succeed at work.
Get Started

Get rid of characters from the cells

adamssap
adamssap asked
on
304 Views
Last Modified: 2012-05-12
Hi:

I have an excel file and I have a VBScript to sort, add columns and do calculations. The script is working fine (as desired) but some how the new excel file has <BR> tag in some of the cells.

Is it possible to get rid of the '<BR>' tags from any cell in the whole file? dfile.csv
Dim xlApp, wb, fil
Dim ws_old, ws_new, rng, cel

Const xlSortOnValues = 0
Const xlTopToBottom = 1
Const xlPinYin = 1
Const xlSortNormal = 0
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
Const xlUp = -4162
Const xlDown = -4121
Const xlGuess = 0
    
fil = "C:\Downloads\dfile.CSV"

Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(fil) 
xlApp.Visible = True
xlApp.ScreenUpdating = False
    
Set ws_old = xlApp.ActiveSheet
Set ws_new = wb.Worksheets.Add 
ws_new.Range("A1").Resize(1, 7).Value = Array("Location", "Credit/Debit", "Date", "Check Num", "Description ", "Account", "Amount")
    

Set rng = ws_old.UsedRange
 
rng.Sort ws_old.Range("D1"), xlAscending, ws_old.Range("A1"), , xlAscending, ws_old.Range("H1"), xlDescending, xlYes
    
Set rng = ws_old.Range(ws_old.Range("A2"), ws_old.Cells(ws_old.Rows.Count, "A").End(-4162)) ' xlUp = -4162
    
For Each cel In rng
    With ws_new.Cells(ws_new.Rows.Count, "C").End(-4162).Offset(1, -2) ' xlUp = -4162
        .Offset(0, 2).Value = cel
        .Offset(0, 4).Value = Trim(Replace(Replace(cel.Offset(0, 10), "/", ""), "<BR>", ""))
        If InStr(cel.Offset(0, 10), "/") > 0 Then
        	tmp = Trim(Left(cel.Offset(0, 10), InStr(cel.Offset(0, 10), "/") - 1))
        Else
        	tmp = Trim(cel.Offset(0, 10))
        End If
        .Offset(0, 5).Value = Right(tmp, Len(tmp) - InStrRev(tmp, " "))
        .Offset(0, 6).Value = cel.Offset(0, 7)
    End With
Next

With ws_new.Range(ws_new.Range("B2"), ws_new.Cells(ws_new.Rows.Count, "C").End(-4162).Offset(0, -1))
    .FormulaR1C1 = "=IF(RC[5]>=0,""Credit"",""Debit"")"
    .Value = .Value
End With

' Excel 2003 Sort
ws_new.UsedRange.Sort ws_new.Range("B2"), xlAscending, ws_new.Range("F2"), , xlAscending, ws_new.Range("C2"), xlAscending, _
	xlGuess, 1, False, xlTopToBottom, xlPinYin, xlSortNormal, xlSortNormal, xlSortNormal

' Excel 2007 Sort
'ws_new.Sort.SortFields.Clear
'ws_new.Sort.SortFields.Add ws_new.Range("B:B"), xlSortOnValues, xlAscending, xlSortNormal
'ws_new.Sort.SortFields.Add ws_new.Range("F:F"), xlSortOnValues, xlAscending, xlSortNormal
'ws_new.Sort.SortFields.Add ws_new.Range("C:C"), xlSortOnValues, xlAscending, xlSortNormal
'With ws_new.Sort
'	.SetRange ws_new.UsedRange
'	.Header = xlYes
'	.MatchCase = False
'	.Orientation = xlTopToBottom
'	.SortMethod = xlPinYin
'	.Apply
'End With

intCreditStart = 0
intCreditEnd = 0
intDebitStart = 0
intDebitEnd = 0

For intRow = 1 To ws_new.Cells(65536, "F").End(xlUp).Row
	If ws_new.Cells(intRow, 2).Value = "Debit" And intDebitStart = 0 Then intDebitStart = intRow
	If ws_new.Cells(intRow, 2).Value = "Debit" Then intDebitEnd = intRow	
Next

If intDebitStart > 0 Then
	intEnd = intDebitEnd
	For intRow = intDebitEnd To intDebitStart Step -1
		If ws_new.Cells(intRow - 1, "F").Value <> ws_new.Cells(intRow, "F").Value Then
			intStart = intRow
			ws_new.Rows(intEnd + 1 & ":" & intEnd + 1).Insert xlDown
			ws_new.Cells(intEnd + 1, "H").Formula = "=SUM(G" & intStart & ":G" & intEnd & ")"
			intStart = intRow - 1
			intEnd = intRow - 1
			intDebitEnd = intDebitEnd + 1
		End If
	Next
	ws_new.Cells(intDebitEnd, "I").Formula = "=SUM(G" & intDebitStart & ":G" & intDebitEnd & ")"
End If

For intRow = 1 To ws_new.Cells(65536, "F").End(xlUp).Row
	If ws_new.Cells(intRow, 2).Value = "Credit" And intCreditStart = 0 Then intCreditStart = intRow
	If ws_new.Cells(intRow, 2).Value = "Credit" Then intCreditEnd = intRow
Next

If intCreditStart > 0 Then
	intEnd = intCreditEnd
	For intRow = intCreditEnd To intCreditStart Step -1
		If ws_new.Cells(intRow - 1, "F").Value <> ws_new.Cells(intRow, "F").Value Then
			intStart = intRow
			ws_new.Rows(intEnd + 1 & ":" & intEnd + 1).Insert xlDown
			ws_new.Cells(intEnd + 1, "H").Formula = "=SUM(G" & intStart & ":G" & intEnd & ")"
			intStart = intRow - 1
			intEnd = intRow - 1
			intCreditEnd = intCreditEnd + 1
		End If
	Next
	ws_new.Cells(intCreditEnd, "I").Formula = "=SUM(G" & intCreditStart & ":G" & intCreditEnd & ")"
End If

ws_new.Columns("C").NumberFormat = "mm/dd/yyyy"
ws_new.Columns("F").NumberFormat = "0000000000"
ws_new.UsedRange.AutoFormat -4154 ' xlRangeAutoFormatSimple = -4154

For intRow = 2 To ws_new.Cells(65536, "H").End(xlUp).Row
	If Left(ws_new.Cells(intRow, "H").Formula, 1) = "=" Then ws_new.Cells(intRow, "H").Interior.Color = 65535
	If Left(ws_new.Cells(intRow, "I").Formula, 1) = "=" Then ws_new.Cells(intRow, "I").Interior.Color = 5296274
Next

ws_new.Cells.EntireColumn.AutoFit

xlApp.ScreenUpdating = True
	
'wb.Close False
	
'xlApp.Quit
	
'Set xlApp = Nothing
'Set wb = Nothing

Open in new window

Comment
Watch Question
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 19 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE