Delete Strikethrough Text and Move Text Below Up One Cell

[FrenchCelt]

Hello,

I have a spreadsheet where someone used strikethrough in Column E to indicate a change and then put the corrected info in the cell underneath. I have a formatting macro that rearranges the data in a way that is useful to my needs, but the strikethrough and correction is throwing it off. What code can I add to cut any cell below a cell with strikethrough and paste over the strikethrough text above? The method I figured would work would be to select/activate a cell with strikethrough text in Column E, offset one cell down, cut, offset one cell up, paste, and repeat the process down the column, but I don't know how to look for the strikethrough text in VBA. My initial assumption is that it will be a For Each type of thing in a range, but I'm not yet fluent enough in the various types of repeating/looping commands in VBA to try building that part on my own.

 

[Alex Blakenburg]

What do you want to happen to the Row that you are cutting the value from ? Delete the row ?
Maybe show us an XL2BB of some sample data and what you want the result to be.
Are any formulas linked to the Cell you are cutting on the destination of were you are pasting it to ?

Just using record macro to will get you to this point, using find for the format.
You would then need to use Find Next to find each occurence.
How many rows are we looking at in total and how many are strikethroughs ?

Sub FindStrikethrough()

    With Application.FindFormat.Font
        .Strikethrough = True
    End With
    
    Cells.Find(What:="*", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate

End Sub

 

[EXCEL MAX]

Try this. Maybe steping could be helpful.

Sub DeleteStrikethroughText()
   
   Application.ScreenUpdating = False
   Set vRng = Range("E1", Cells(Rows.Count, "E").End(xlUp))
   For vN = 1 To vRng.Rows.Count Step 2
      If vRng.Cells(vN).Font.Strikethrough = True Then
         vRng.Cells(vN + 1).Cut vRng.Cells(vN)
      End If
   Next vN
   Application.ScreenUpdating = True

End Sub

 

[FrenchCelt]

What do you want to happen to the Row that you are cutting the value from ? Delete the row ?
Maybe show us an XL2BB of some sample data and what you want the result to be.
Are any formulas linked to the Cell you are cutting on the destination of were you are pasting it to ?

Just using record macro to will get you to this point, using find for the format.
You would then need to use Find Next to find each occurence.
How many rows are we looking at in total and how many are strikethroughs ?

Sub FindStrikethrough()

    With Application.FindFormat.Font
        .Strikethrough = True
    End With
   
    Cells.Find(What:="*", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate

End Sub

Ok, I took this as my starting point and took some elements from another macro I have to create this:

With Application.FindFormat.Font
        .Strikethrough = True
    End With
    Cells.Find(What:="*", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
    ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
    Selection.Cut
    ActiveCell.Offset(rowOffset:=-1, columnOffset:=0).Activate
    ActiveSheet.Paste

And it did exactly what I wanted for the topmost example. Now how can I make this repeat down the worksheet until it gets all of the strikethrough text?

 

[FrenchCelt]

Try this. Maybe steping could be helpful.

Sub DeleteStrikethroughText()
  
   Application.ScreenUpdating = False
   Set vRng = Range("E1", Cells(Rows.Count, "E").End(xlUp))
   For vN = 1 To vRng.Rows.Count Step 2
      If vRng.Cells(vN).Font.Strikethrough = True Then
         vRng.Cells(vN + 1).Cut vRng.Cells(vN)
      End If
   Next vN
   Application.ScreenUpdating = True

End Sub

This bit of code was hit or miss. Out of 5 cases of strikethrough, it worked on 2 of them and left the other 3 unchanged. And they weren't sequential...it skipped over a few and worked on others.

 

[mumps]

Try:

Sub FindStrikethrough()
    Application.ScreenUpdating = False
    Dim x As Long, LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = LastRow To 2 Step -1
        If Range("E" & x).Font.Strikethrough = True Then
            Range("E" & x + 1).Cut Range("E" & x)
        End If
    Next x
    Application.ScreenUpdating = False
End Sub

 

[FrenchCelt]

Saving the day for me once again, mumps. Thanks a lot, it worked seamlessly.

 

[mumps]

You are very welcome.