Quick Help!!! - remove character at position "X"

[Stephen]

hi Folks,

I'm in desperate need of a macro that will traverse down an entire column
and remove the seventh character...
12345678, will become
1234568

TIA!!!

Steve

 

[jabbott]

Sub Remove7thCharacter()
Dim t_Range As Excel.Range
Dim t_Col As Long
Dim t_Rows As Long

On Error GoTo Quit
Set t_Range = ActiveWindow.Selection
t_Col = t_Range.Rows.Column
t_Rows = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row -
1)

For r = ActiveSheet.UsedRange.Row To t_Rows
t_text = ActiveSheet.Cells(r, t_Col).Text

If Len(t_text) > 6 Then
t_text = Left(t_text, 6) + Mid(t_text, 8)
ActiveSheet.Cells(r, t_Col) = t_text
End If
Next
Quit:
End Sub

 

[Bernie Deitrick]

Steve,

You could simple enter a formula like this

=LEFT(A2,6)&MID(A2,8,LEN(A2))

into another column, copy down, then copy and paste values over the original. Either manually or
with a macro would be simple...

HTH,
Bernie
MS Excel MVP

 

[Stephen]

Perfect, works like a charm!

Many Thanks!!!

Sub Remove7thCharacter()
Dim t_Range As Excel.Range
Dim t_Col As Long
Dim t_Rows As Long

On Error GoTo Quit
Set t_Range = ActiveWindow.Selection
t_Col = t_Range.Rows.Column
t_Rows = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row -
1)

For r = ActiveSheet.UsedRange.Row To t_Rows
t_text = ActiveSheet.Cells(r, t_Col).Text

If Len(t_text) > 6 Then
t_text = Left(t_text, 6) + Mid(t_text, 8)
ActiveSheet.Cells(r, t_Col) = t_text
End If
Next
Quit:
End Sub

 

[Don Guillett]

Or a macro to do the same
Sub trimtosevenchar()
mc = "k"
On Error Resume Next
For i = 1 To Cells(Rows.Count, mc).End(xlUp).Row
Set myc = Cells(i, mc)
If Len(myc) > 6 Then myc.Value = Left(myc, 6) & Mid(myc, Len(myc))
Next
End Sub

 

[Rick Rothstein \(MVP - VB\)]

You could simple enter a formula like this

=LEFT(A2,6)&MID(A2,8,LEN(A2))

into another column, copy down, then copy and paste values over the
original.
Either manually or with a macro would be simple...

Another possibility...

=REPLACE(A2,7,1,"")

Rick