How can I make removal of Strikethrough text in Excel cells using XML parsing more robust? - excel

Question

I have a complex spreadsheet with many cells of text containing random mixtures of normal text and text with strikethrough. Before I scan a cell for useful information, I have to remove the struck through text. I intially achieved this (with VBA) using the Characters object, but it was so slow as to be totally impractical, for business purposes. I was then kindly supplied with some code (on this site) that parses the XML encoding. This was 1000's of times faster, but it occassionally causes the following error:
"The parameter node is not a child of this node".
So far, it only happens in heavily loaded cells (1000's of characters), otherwise it works fine. I cannot see anything wrong in the code or the XML structure of the problem cells, although I am a total newbie to XML. Using the VBA debugger, I know the error is occurring when RemoveChild() is called, typically when it has already worked without error on a few struck through sections of a cell's text.
Is there a way I could make the following code more robust?
Public Sub ParseCellForItems(TargetCell As Excel.Range, ItemsInCell() As String)
Dim XMLDocObj As MSXML2.DOMDocument60
Dim x As MSXML2.IXMLDOMNode
Dim s As MSXML2.IXMLDOMNode
Dim CleanedCellText As String
On Error GoTo ErrorHandler
Call UnstrikeLineBreakCharsInCell(TargetCell)
Set XMLDocObj = New MSXML2.DOMDocument60
'Add some namespaces.
XMLDocObj.SetProperty "SelectionNamespaces", "xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
"xmlns:ht='http://www.w3.org/TR/REC-html40'"
'Load the cell data as XML into XMLDOcObj.
If XMLDocObj.LoadXML(TargetCell.Value(xlRangeValueXMLSpreadsheet)) Then
Set x = XMLDocObj.SelectSingleNode("//ss:Data") 'Cell content.
If Not x Is Nothing Then
Set s = x.SelectSingleNode("//ht:S") 'Struck through cell content.
Do While Not s Is Nothing
x.RemoveChild s
Set s = x.SelectSingleNode("//ht:S")
Loop
CleanedCellText = XMLDocObj.Text
'Parse CleanedCellText for useful information.'
'...
End If
End If
Set XMLDocObj = Nothing
'Presumably don't have to 'destroy' x and s as well, as they were pointing to elements of XMLObj.
Exit Sub
ErrorHandler:
Call RaiseError(Err.Number, Err.Source, "ParseCellForItems()", Err.Description, Erl)
End Sub
Public Sub UnstrikeLineBreakCharsInCell(TargetCell As Excel.Range)
Dim mc As MatchCollection
Dim RegExObj1 As RegExp
Dim Match As Variant
On Error GoTo ErrorHandler
Set RegExObj1 = New RegExp
RegExObj1.Global = True
RegExObj1.IgnoreCase = True
RegExObj1.Pattern = "\n" 'New line. Equivalent to vbNewLine.
Set mc = RegExObj1.Execute(TargetCell.Value)
For Each Match In mc
TargetCell.Characters(Match.FirstIndex + 1, 1).Font.Strikethrough = False
Next Match
Set mc = Nothing
Set RegExObj1 = Nothing
Exit Sub
ErrorHandler:
Call RaiseError(Err.Number, Err.Source, "UnstrikeLineBreakCharsInCell()", Err.Description, Erl)
End Sub

Answer 1

Yep, as per Tim Williams' comment, making sure you're calling RemoveChild() from its immediate parent fixes the problem:
Set s = x.SelectSingleNode("//ht:S")
Do While Not s Is Nothing
s.ParentNode.RemoveChild s
Set s = x.SelectSingleNode("//ht:S")
Loop