How to add a trim formula using VBA code

Kenor

Board Regular
Joined
Dec 8, 2020
Messages
116
Office Version
  1. 2016
Platform
  1. Windows
Hi Everyone..

I have used the VBA code below to transfer data from another sheet to another sheet before.
___________________________________________________________

Sub RoundedRectangle6_Click()

Dim wsIN As Worksheet
Dim wsRegister_IN As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsIN = Worksheets("IN")
Set wsRegister_IN = Worksheets("Register IN")

CopyLastRow = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1

wsIN.Range("A3", "J" & CopyLastRow).Copy Destination:=wsRegister_IN.Range("A" & DestLastRow)
wsIN.Range("A3", "A" & CopyLastRow).EntireRow.Delete

End Sub

______________________________________________________________

But I have one problem that all the data in the D & E column has extra space from the text.

I need to remove all the extra space to make sure the formulas in the other sheets can track all the available data.

This is how data with extra space from text >>
1631454052838.png



So I want to add a trim formula in the VBA code above.

Or is there another solution ?

Anyone can help me..


Thanks
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Hi
Your problem is that you wish to copy and manipulate the text i one action.
That would mean the .copy function of the range object had an option like Trim:=True :-) but it doesn't.

That leaves you with trimming the data before or after the copy is executed.
I would use "cell = trim(cell)" at the destination cell

/Lyd
 
Upvote 0
Try this....
VBA Code:
Sub RoundedRectangle6_Click()

Dim wsIN As Worksheet
Dim wsRegister_IN As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim c As Range
Set wsIN = Worksheets("IN")
Set wsRegister_IN = Worksheets("Register IN")

CopyLastRow = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False
For Each c In Range("D3:E" & CopyLastRow)
    c.Value = WorksheetFunction.Trim(cell.Value)
Next c

wsIN.Range("A3", "J" & CopyLastRow).Copy Destination:=wsRegister_IN.Range("A" & DestLastRow)
wsIN.Range("A3", "A" & CopyLastRow).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Hope that helps.
 
Upvote 0
Hi Everyone..

I have used the VBA code below to transfer data from another sheet to another sheet before.
___________________________________________________________

Sub RoundedRectangle6_Click()

Dim wsIN As Worksheet
Dim wsRegister_IN As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsIN = Worksheets("IN")
Set wsRegister_IN = Worksheets("Register IN")

CopyLastRow = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1

wsIN.Range("A3", "J" & CopyLastRow).Copy Destination:=wsRegister_IN.Range("A" & DestLastRow)
wsIN.Range("A3", "A" & CopyLastRow).EntireRow.Delete

End Sub

______________________________________________________________

But I have one problem that all the data in the D & E column has extra space from the text.

I need to remove all the extra space to make sure the formulas in the other sheets can track all the available data.

This is how data with extra space from text >>
View attachment 46732


So I want to add a trim formula in the VBA code above.

Or is there another solution ?

Anyone can help me..


Thanks


For cleaning up data, check out the solution that Jon Peltier provided to me recently. It is amazingly fast.
 
Upvote 0
VBA Code:
Sub RoundedRectangle6_Click()
'
    Dim CopyLastRowPlus1    As Long
    Dim DestLastRowPlus1    As Long
    Dim CopyStartRow        As Long
    Dim TrimRangeArray      As Variant
    Dim wsIN                As Worksheet
    Dim wsRegister_IN       As Worksheet
'
    Set wsIN = Worksheets("IN")
    Set wsRegister_IN = Worksheets("Register IN")
'
    CopyLastRowPlus1 = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
    DestLastRowPlus1 = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1
    CopyStartRow = 3                                                                            ' <--- Set this to desired start row of data
'
    TrimRangeArray = wsIN.Range("D" & CopyStartRow & ":E" & CopyLastRowPlus1 - 1)               ' save trim range into 2D array row, column
'
    For RangeRowCounter = 1 To UBound(TrimRangeArray)                                           ' Loop to remove leading and trailing spaces from array range
        TrimRangeArray(RangeRowCounter, 1) = Trim(TrimRangeArray(RangeRowCounter, 1))           '   Remove spaces from first column in array range
        TrimRangeArray(RangeRowCounter, 2) = Trim(TrimRangeArray(RangeRowCounter, 2))           '   Remove spaces from 2nd column in array range
    Next
'
    wsIN.Range("D" & CopyStartRow & ":E" & CopyLastRowPlus1 - 1) = TrimRangeArray               ' write the range back to worksheet
'
    wsIN.Range("A" & CopyStartRow & ":J" & CopyLastRowPlus1).Copy Destination:=wsRegister_IN.Range("A" & DestLastRowPlus1)
    wsIN.Range("A" & CopyStartRow & ":A" & CopyLastRowPlus1).EntireRow.Delete
End Sub
 
Upvote 0
Solution
Try this....
VBA Code:
Sub RoundedRectangle6_Click()

Dim wsIN As Worksheet
Dim wsRegister_IN As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim c As Range
Set wsIN = Worksheets("IN")
Set wsRegister_IN = Worksheets("Register IN")

CopyLastRow = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False
For Each c In Range("D3:E" & CopyLastRow)
    c.Value = WorksheetFunction.Trim(cell.Value)
Next c

wsIN.Range("A3", "J" & CopyLastRow).Copy Destination:=wsRegister_IN.Range("A" & DestLastRow)
wsIN.Range("A3", "A" & CopyLastRow).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Hope that helps.

Hi Snakehips,

I already try above code but have error.

1631592124104.png
 
Upvote 0
VBA Code:
Sub RoundedRectangle6_Click()
'
    Dim CopyLastRowPlus1    As Long
    Dim DestLastRowPlus1    As Long
    Dim CopyStartRow        As Long
    Dim TrimRangeArray      As Variant
    Dim wsIN                As Worksheet
    Dim wsRegister_IN       As Worksheet
'
    Set wsIN = Worksheets("IN")
    Set wsRegister_IN = Worksheets("Register IN")
'
    CopyLastRowPlus1 = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
    DestLastRowPlus1 = wsRegister_IN.Range("A" & wsRegister_IN.Rows.Count).End(xlUp).Row + 1
    CopyStartRow = 3                                                                            ' <--- Set this to desired start row of data
'
    TrimRangeArray = wsIN.Range("D" & CopyStartRow & ":E" & CopyLastRowPlus1 - 1)               ' save trim range into 2D array row, column
'
    For RangeRowCounter = 1 To UBound(TrimRangeArray)                                           ' Loop to remove leading and trailing spaces from array range
        TrimRangeArray(RangeRowCounter, 1) = Trim(TrimRangeArray(RangeRowCounter, 1))           '   Remove spaces from first column in array range
        TrimRangeArray(RangeRowCounter, 2) = Trim(TrimRangeArray(RangeRowCounter, 2))           '   Remove spaces from 2nd column in array range
    Next
'
    wsIN.Range("D" & CopyStartRow & ":E" & CopyLastRowPlus1 - 1) = TrimRangeArray               ' write the range back to worksheet
'
    wsIN.Range("A" & CopyStartRow & ":J" & CopyLastRowPlus1).Copy Destination:=wsRegister_IN.Range("A" & DestLastRowPlus1)
    wsIN.Range("A" & CopyStartRow & ":A" & CopyLastRowPlus1).EntireRow.Delete
End Sub

Hi JohnnyL,

I also already try above code but have error..

1631592222053.png
 
Upvote 0
@Snakehips I think you want to replace:

VBA Code:
    c.Value = WorksheetFunction.Trim(cell.Value)

with:

VBA Code:
    c.Value = WorksheetFunction.Trim(c.Value)

;)
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top