How to add a trim formula using VBA code

K

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

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
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
Kenor said:
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
Click to expand...


For cleaning up data, check out the solution that Jon Peltier provided to me recently. It is amazingly fast.
www.mrexcel.com

How can I make this faster?

I often receive data files that need some cleanup so I have created a macro to trim and remove carriage returns. It works well and is pretty quick (few seconds) when the range is, say, 1500 cells but its much slower (60+ secs) if there are 5-10k+. How can I speed this up? Or does someone have...
www.mrexcel.com www.mrexcel.com
 
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
Snakehips said:
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.
Click to expand...

Hi Snakehips,

I already try above code but have error.

1631592124104.png
 
Upvote 0
johnnyL said:
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
Click to expand...

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
You must log in or register to reply here.

Similar threads

E
  • Solved
Excel VBA - Select and combine dynamic ranges
Replies
7
Views
900
DanteAmor
DanteAmor
K
  • Solved
Copies data from one sheet to another sheet but skips one column of data
Replies
6
Views
647
Fluff
Fluff
K
  • Question Question
To paste data to another sheet by separating several columns
Replies
2
Views
359
Kenor
K
K
  • Locked
  • Question Question
Copies data from one sheet to another sheet but skip one column
Replies
1
Views
597
Fluff
Fluff
D
  • Solved
Use VBA to check if source date is present on target sheet before copying data
Replies
3
Views
681
dmt32
D

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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