Trim Clean VBA Code not working for long data

[AAP]

Hi Everyone,
I have written trim clean function in vba but it does not working like it is working in excel worksheet function =trim(clean()) I normally receives data from different sources like sap, oracle and html websites and then we paste into excel. I need a code that can remove undesired characters and spaces. Many thanks for help.

 

[Hui]

Change the line:

From:

If r <> vbNullString Then r = WorksheetFunction.Clean(Trim(r))

To:

If r <> vbNullString Then r = WorksheetFunction.Clean(WorksheetFunction.Trim(r))

All worksheet functions need a WorksheetFunction. preceding them

 

[AAP]

Change the line:

From:

If r <> vbNullString Then r = WorksheetFunction.Clean(Trim(r))

To:

If r <> vbNullString Then r = WorksheetFunction.Clean(WorksheetFunction.Trim(r))

All worksheet functions need a WorksheetFunction. preceding them

Many thanks Hui,
I have changed it as you suggested but still getting an error when running with the new pasted data on the sheet. Could you see any problems yet?

 

[Hui]

Try this slightly modified code

Sub trimclean()

Dim r As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.StatusBar = "Trimming & Cleaning your data"
End With

ThisWorkbook.Worksheets("Paste Data Here").Activate
On Error Resume Next
For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
  If r <> vbNullString Then r = WorksheetFunction.Trim(WorksheetFunction.Clean(r.Text))
Next r

ActiveSheet.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy

Workbooks.Add
ActiveSheet.Cells(1, 1).Select
ActiveCell.PasteSpecial (xlPasteValues)

With Application
.CutCopyMode = False
.ScreenUpdating = True
.StatusBar = False
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ThisWorkbook.Close

End Sub

Note the error handling to allow processing of cells with errors

 

[Hui]

If you want to also remove the rows with errors use the following slightly modified code:

Sub trimclean()

Dim r As Integer

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
  .StatusBar = "Trimming & Cleaning your data"
End With

ThisWorkbook.Worksheets("Paste Data Here").Activate
On Error Resume Next

For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
  If Cells(r, 1).Text = "#N/A" Then
  Cells(r, 1).EntireRow.Delete
  ElseIf Cells(r, 1).Text <> vbNullString Then
  Cells(r, 1).Text = WorksheetFunction.Trim(WorksheetFunction.Clean(Cells(r, 1).Text))
  End If
Next r

ActiveSheet.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy

Workbooks.Add
ActiveSheet.Cells(1, 1).Select
ActiveCell.PasteSpecial (xlPasteValues)

With Application
  .CutCopyMode = False
  .ScreenUpdating = True
  .StatusBar = False
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
End With
ThisWorkbook.Close

End Sub

 

[AAP]

If you want to also remove the rows with errors use the following slightly modified code:

Sub trimclean()

Dim r As Integer

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
  .StatusBar = "Trimming & Cleaning your data"
End With

ThisWorkbook.Worksheets("Paste Data Here").Activate
On Error Resume Next

For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
  If Cells(r, 1).Text = "#N/A" Then
  Cells(r, 1).EntireRow.Delete
  ElseIf Cells(r, 1).Text <> vbNullString Then
  Cells(r, 1).Text = WorksheetFunction.Trim(WorksheetFunction.Clean(Cells(r, 1).Text))
  End If
Next r

ActiveSheet.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy

Workbooks.Add
ActiveSheet.Cells(1, 1).Select
ActiveCell.PasteSpecial (xlPasteValues)

With Application
  .CutCopyMode = False
  .ScreenUpdating = True
  .StatusBar = False
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
End With
ThisWorkbook.Close

End Sub

Thanks Hui, but this code running for the last 10 minutes. I think there is some problem.

 

[AAP]

Any advice please?

 

[shrivallabha]

You can skip looping and check.

Sub TrimClean2()
Dim wb As Workbook
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
  .Value = Application.Clean(Application.Trim(.Value))
  .Copy
End With
Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

 

[AAP]

You can skip looping and check.

Sub TrimClean2()
Dim wb As Workbook
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
  .Value = Application.Clean(Application.Trim(.Value))
  .Copy
End With
Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Thanks Shrivallabha, its working awesome. But for curosity, what's the difference between these two methods?

 

[shrivallabha]

From end result point of view there's no difference. However, the owner object is "Application" as opposed to "Worksheetfunction". So error handling differs slightly if one needs to handle it.

Since it is capable of processing arrays we can skip loop.

PS: I think there's a limitation of string length(256) when Application.Trim is used. You can ignore if individual strings are not that big. And you can google if you are curious.