I work with a spreadsheet staffing roster and I use VBA to copy and format
information from the roster to other spreadsheets. People who maintain the
roster enter names of planned vacation or training and if these don't take
place they change the font to strikethrough afterwards. There may be more
than one name in a cell so I often get something like:

Smith / Jones

with Jones in strikethough

Within my VBA procedures I'd like to identify the strikethorugh characters
and delete them so in the above example I'd just copy 'Smith' to another
spreadsheet.

TIA for any help or suggestions

This request is more complicated than you think. You have to check each
character in the string for the strikethrough.


Sub GetStrikethrough()

Set MyCell = Sheets("Sheet1").Range("A1")
'get length of string
StrLen = Len(MyCell.Text)

'first character position of strike through
StartChar = 0
'last character position of strike through
EndChar = 0
'check each character of string for a strikethrough
For CharCount = 1 To StrLen
'get each character in string
Set Mychar = MyCell.Characters(Start:=CharCount, _
Length:=1).Font

'check for 1st strike through character
If Mychar.Strikethrough = True Then
If StartChar = 0 Then

StartChar = CharCount
End If
Else
'check for 1st non strike through after
'a strikethrough is found
If StartChar 0 Then
EndChar = CharCount
Exit For
End If
End If
Next CharCount
'If last character in string is a strike through
'the make EndChar the last character in string
If StartChar 0 And _
EndChar = 0 Then

EndChar = StrLen
End If

'remove strinkethrough if found
If StartChar 0 Then
StrikeLen = EndChar - StartChar + 1
'Get strike through string
Strikethrough = Mid(MyCell.Text, StartChar, StrikeLen)

'remnove strik through from string
TextData = ""
'get character before strikethrough
If StartChar 1 Then
TextData = Left(MyCell, StartChar - 1)
End If
'get character after strikethrough
If EndChar < StrLen Then
'get num character after strikethrough
endLen = StrLen - EndChar + 1
TextData = TextData & Mid(MyCell, EndChar + 1, endLen)
End If
MyCell.Value = TextData
End If
'store strikethough character on new sheet
Sheets("Sheet2").Range("A1") = Strikethrough
End Sub


"Ralph" wrote:

I work with a spreadsheet staffing roster and I use VBA to copy and format
information from the roster to other spreadsheets. People who maintain the
roster enter names of planned vacation or training and if these don't take
place they change the font to strikethrough afterwards. There may be more
than one name in a cell so I often get something like:

Smith / Jones

with Jones in strikethough

Within my VBA procedures I'd like to identify the strikethorugh characters
and delete them so in the above example I'd just copy 'Smith' to another
spreadsheet.

TIA for any help or suggestions

I got this to work on a single test cell. Try it out and see if you can use
it.

Sub sl()
For i = Len(Range("B3").Value) To 1 Step -1
If Range("B3").Characters(i, 1).Font.Strikethrough = True Then
Range("B3").Characters(i, 1).Delete
End If
Next
End Sub





"Ralph" wrote in message
...
I work with a spreadsheet staffing roster and I use VBA to copy and format
information from the roster to other spreadsheets. People who maintain the
roster enter names of planned vacation or training and if these don't take
place they change the font to strikethrough afterwards. There may be more
than one name in a cell so I often get something like:

Smith / Jones

with Jones in strikethough

Within my VBA procedures I'd like to identify the strikethorugh characters
and delete them so in the above example I'd just copy 'Smith' to another
spreadsheet.

TIA for any help or suggestions