How to loop thru an entire activesheet, search and remove a text and shift the remaining cells to the left

[spidertech]

Hi,

I need some help please. How do I search the entire active worksheet for a particular word, say "XYZ", remove/delete a text contains "XYZ" and be able to shift the remain of the values in that row one cell over to the left?
A1 A2 A3 A4 A5
XYZ B1 B2 B3 B4

Result:
A1 A2 A3 A4 A5
B1 B2 B3 B4

 

[maabadi]

If your first row and Columns Have Data , Try this:

Sub DeleteShiftLeft()
Dim i As Long, j As Long, Lr As Long, LC As Long
Dim Cell As Range, MyRange As Range
Lr = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Set MyRange = Range(Cells(1, 1), Cells(Lr, LC))

For j = LC To 1 Step -1
For i = Lr To 1 Step -1
If Cells(i, j).Value = "XYZ" Then
Cells(i, j).Delete (xlShiftToLeft)
End If
Next i
Next j
End Sub

 

[spidertech]

If your first row and Columns Have Data , Try this:

Sub DeleteShiftLeft()
Dim i As Long, j As Long, Lr As Long, LC As Long
Dim Cell As Range, MyRange As Range
Lr = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Set MyRange = Range(Cells(1, 1), Cells(Lr, LC))

For j = LC To 1 Step -1
For i = Lr To 1 Step -1
If Cells(i, j).Value = "XYZ" Then
Cells(i, j).Delete (xlShiftToLeft)
End If
Next i
Next j
End Sub

Thank you maabadi. It works.

 

[maabadi]

You're Welcome & Thanks for feedback.