Hi,
I am trying to write some code that will find a string in a range, insert a row above the position that it has been found. Copy the value to the new cell above and delete the original.
Then for each cell that the string is found in below the copy, the contents of that cell are deleted.
The code then moves on to the next string and handles it in the same way.
However my code runs into an infinite loop if the string only appears once or twice.
Can anyone help me with this one....PLEASE.
Here is the code;
Sub tidy()
Dim c As Range
Dim z As Integer, x As Integer
Range("F3").Select
x = 3
Do While ActiveCell.Offset(-1, 0).Value <> ActiveCell.Value
If ActiveCell.Offset(-1, 0).Value <> ActiveCell.Value Then
If ActiveCell.Offset(1, 0).Value = ActiveCell.Value Then
ActiveCell.Offset(1, 0).ClearContents
ActiveCell.EntireRow.Insert
ActiveCell.Offset(1, 0).Copy
ActiveCell.Offset(0, 0).PasteSpecial (xlPasteValues)
ActiveCell.Offset(1, 0).Clear
' ElseIf ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then
' ActiveCell.Offset(0, 0).Copy
' ActiveCell.EntireRow.Insert
' ActiveCell.Offset(0, 0).PasteSpecial (xlPasteValues)
' ActiveCell.Offset(1, 0).ClearContents
x = 3
Do While ActiveCell.Offset(x, 0).Value = ActiveCell.Value
If ActiveCell.Offset(x, 0).Value = ActiveCell.Value Then
ActiveCell.Offset(x, 0).Clear
Set c = ActiveCell.Offset(x + 1, 0)
x = x + 1
End If
Loop
End If
End If
c.Select
'z = (x + 3)
'Range("F" & z).Select
Loop
End Sub
ANY help / comments would be great.
Regards,
Rocks
