asked on

Get rid of characters from the cells

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 tag in some of the cells.

Is it possible to get rid of the ' ' 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

ScriptAddict

Find 
and replace with ""

or something incorporating:

Sub FormulaFindAndReplace(phrase As String) 
  For Each Sheet_Select In ActiveWorkbook.Worksheets 
    Sheet_Select.Activate 
    Set Found_Link = Cells.Find(what:=phrase, After:=ActiveCell, _ 
        LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows, _ 
        searchdirection:=xlNext, MatchCase:=False) 
    While UCase(TypeName(Found_Link)) <> UCase("Nothing") 
       Found_Link.Activate 
       Found_Link.Formula = Replace(Found_Link.Formula, phrase, "") 
       Set Found_Link = Cells.FindNext(After:=ActiveCell) 
    Wend 
  Next Sheet_Select 
End Sub

Open in new window

ScriptAddict

Add the above code and then adjust your original code like this

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

FormulaFindAndReplace("<BR>")
    
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

adamssap

ASKER

Where should I add the Sub in the script?

Do I need to call it?

Thanks.

ScriptAddict

The way to call it is to add it to your script after the is created. I've included the line to insert.

ws_new.Cells.EntireColumn.AutoFit

FormulaFindAndReplace("<BR>")

xlApp.ScreenUpdating = True
'wb.Close False
'xlApp.Quit
'Set xlApp = Nothing
'Set wb = Nothing 
Toggle HighlightingOpen in New Window

Open in new window

Will likely do the trick

adamssap

ASKER

I am getting an error in line 22, attached is the complete code.

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

ws_new.Cells.EntireColumn.AutoFit

FormulaFindAndReplace("<BR>")

xlApp.ScreenUpdating = True
'wb.Close False
'xlApp.Quit
'Set xlApp = Nothing
'Set wb = Nothing 
    
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

ScriptAddict

Did you already add the sub code?

Sub FormulaFindAndReplace(phrase As String) 
  For Each Sheet_Select In ActiveWorkbook.Worksheets 
    Sheet_Select.Activate 
    Set Found_Link = Cells.Find(what:=phrase, After:=ActiveCell, _ 
        LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows, _ 
        searchdirection:=xlNext, MatchCase:=False) 
    While UCase(TypeName(Found_Link)) <> UCase("Nothing") 
       Found_Link.Activate 
       Found_Link.Formula = Replace(Found_Link.Formula, phrase, "") 
       Set Found_Link = Cells.FindNext(After:=ActiveCell) 
    Wend 
  Next Sheet_Select 
End Sub

Open in new window

ScriptAddict

Just plug that in after the end sub on the other code.

adamssap

ASKER

I added the sub and here is the complete code. I get error on line 24 now.

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

ws_new.Cells.EntireColumn.AutoFit

Sub FormulaFindAndReplace(phrase As String) 
  For Each Sheet_Select In ActiveWorkbook.Worksheets 
    Sheet_Select.Activate 
    Set Found_Link = Cells.Find(what:=phrase, After:=ActiveCell, _ 
        LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows, _ 
        searchdirection:=xlNext, MatchCase:=False) 
    While UCase(TypeName(Found_Link)) <> UCase("Nothing") 
       Found_Link.Activate 
       Found_Link.Formula = Replace(Found_Link.Formula, phrase, "") 
       Set Found_Link = Cells.FindNext(After:=ActiveCell) 
    Wend 
  Next Sheet_Select 
End Sub 

FormulaFindAndReplace("<BR>")

xlApp.ScreenUpdating = True
'wb.Close False
'xlApp.Quit
'Set xlApp = Nothing
'Set wb = Nothing 
    
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

ScriptAddict

I'm sorry I wasn't clear. I'm sure that after line 158 you must have something that says end sub right before the line

You want to add the function code there.

Please remove lines 24-36 and add them after the end of the code. so beyond line 158.

adamssap

ASKER

Now the error is on line 147.

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

ws_new.Cells.EntireColumn.AutoFit


FormulaFindAndReplace("<BR>")

xlApp.ScreenUpdating = True
'wb.Close False
'xlApp.Quit
'Set xlApp = Nothing
'Set wb = Nothing 
    
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

Sub FormulaFindAndReplace(phrase As String) 
  For Each Sheet_Select In ActiveWorkbook.Worksheets 
    Sheet_Select.Activate 
    Set Found_Link = Cells.Find(what:=phrase, After:=ActiveCell, _ 
        LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows, _ 
        searchdirection:=xlNext, MatchCase:=False) 
    While UCase(TypeName(Found_Link)) <> UCase("Nothing") 
       Found_Link.Activate 
       Found_Link.Formula = Replace(Found_Link.Formula, phrase, "") 
       Set Found_Link = Cells.FindNext(After:=ActiveCell) 
    Wend 
  Next Sheet_Select 
End Sub

Open in new window

ScriptAddict

Your not posting all of the code. There must be something after line 159.

If there is NOTHING beyond line 159 then just put a

end sub on line 146.

adamssap

ASKER

I am sorry but this is the complete code. If there is no Sub, why should I add End Sub after line 146. Error is on line 147. Is it working on your computer?

Thanks for your help.

ScriptAddict

Sorry I've been doing VBA for Excel almost exclusively here. You've got to admit they look very similar.

This should work for you

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
	If InStr(cel.Offset(0, 10), "<BR>") > 0 Then
        	tmp = Trim(Left(cel.Offset(0, 10), InStr(cel.Offset(0, 10), "<BR>") - 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

adamssap

ASKER

Thanks, that works good, but data in the resulting sheet on the column 'Account' must be the last number .

eg 1:
MERCHANT SERVICE MERCH DEP 111012 17789000052801
then the account is 17789000052801
eg. 2:
MERCHANT SERVICE MERCH DEP 111012 17789000052801
then account is 17789000052801

But now the script is adding 111012 to the Account column.

Thanks again for your help.

ScriptAddict

This should fix it.

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

 	If InStr(tmp, "<BR>") > 0 Then
        	tmp = Trim(Left(tmp, InStr(tmp, "<BR>") - 4))
        Else
        	tmp = Trim(tmp)
        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

adamssap

ASKER

Not really, maybe I am not clear. Account is right most number.

for example: MERCHANT SERVICE MERCH DEP 111012 17789000052801

Here the Account is 17789000052801 and not 111012

adamssap

ASKER

I just found out that the script is giving wrong account for some row only. Please see attached file
dfile.CSV

adamssap

ASKER

Please ignore previous message. The script is giving wrong account only when it has the ' ' tag. See attached screenshot

ASKER CERTIFIED SOLUTION

ScriptAddict

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial