Trim Contents of Current Cell

[Scambini]

I need a macro that deletes the first 4 words of text in the active cell. When I record the macro, it copies the text from the cell in which I defined the macro and pastes this into any cell I try the macro in. I get the script below. I know the "6 September 1863" is the problem, but do not what to change it to in VBA.
Ideas?


Sub Macro12()
'
' Macro12 Macro
' Trim 4 words from contents of Current Cell
'
' Keyboard Shortcut: Ctrl+e
'
ActiveCell.FormulaR1C1 = "6 September 1863"
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

 

[Bamberg]

Hi,

this script will cut the text til the 4th blank in your current cell.
<pre style='border:thin solid #9B9B9B; padding:12px 24px; margin-left:12px; color:#1B3636; overflow:auto; '><span style='color:#0000EE'>Sub</span> Trim_Contents()

<span style='color:#0000EE'>Dim</span> vArr <span style='color:#0000EE'>As</span> <span style='color:#0000EE'>Variant</span>
<span style='color:#0000EE'>Dim</span> lLength <span style='color:#0000EE'>As</span> <span style='color:#0000EE'>Long</span>

vArr = Split(ActiveCell.Text, <span style='color:#FF3E3E'>" "</span>)
<span style='color:#0000EE'>If</span> <span style='color:#0000EE'>Ubound</span>(vArr) > <span style='color:#DDAA00'>3</span> <span style='color:#0000EE'>Then</span>
<span style='color:#0000EE'>For</span> lLength = <span style='color:#DDAA00'>4</span> <span style='color:#0000EE'>To</span> <span style='color:#0000EE'>Ubound</span>(vArr)
vArr(lLength - <span style='color:#DDAA00'>4</span>) = vArr(lLength)
<span style='color:#0000EE'>Next</span> lLength
<span style='color:#0000EE'>Redim</span> <span style='color:#0000EE'>Preserve</span> vArr(<span style='color:#DDAA00'>4</span> <span style='color:#0000EE'>To</span> <span style='color:#0000EE'>Ubound</span>(vArr))

ActiveCell.Value = Join(vArr, <span style='color:#FF3E3E'>" "</span>)
<span style='color:#0000EE'>Else</span>
MsgBox <span style='color:#FF3E3E'>"without 4 words!"</span>, , <span style='color:#FF3E3E'>"Error"</span>
<span style='color:#0000EE'>End</span> <span style='color:#0000EE'>If</span>

<span style='color:#0000EE'>Erase</span> vArr
<span style='color:#0000EE'>Set</span> vArr = <span style='color:#0000EE'>Nothing</span>
<span style='color:#0000EE'>End</span> <span style='color:#0000EE'>Sub</span></pre>Best wishes
Gerd

 

[Scambini]

Thanks Bamberg

It works just fine.

Is it possible to add a move down 6 rows after performing the trim?

 

[Burrgogi]

Thanks Bamberg

It works just fine.

Is it possible to add a move down 6 rows after performing the trim?

Copy & paste this in to the VBA rountine that Bamberg gave you. Paste it just before the line where it says End Sub.

ActiveCell.Offset(6, 0).Activate

 

[Scambini]

Burrgogi,

The added script worked like a charm! Have a good day.

Scambini