Shift cells up for blank rows in multiple columns

[dvitale71]

Hi,
I am trying to delete and shift cells up for multiple columns but can't seem to get this to work. Any help is appreciated!

Task: If columns F through K are blank, then delete and shift cells A through K up. (note: I'm trying to shift additional columns A through E)

Here is the code I have edited thus far... however, I'm not sure where to go from here where I would include shifting cells a through k up.

Sub DeleteBlanksShiftUp ()
Dim lRow As Integer
Dim intCol As Long
Dim rngCell As Range, fn


Set fn = Application.WorksheetFunction
Application.ScreenUpdating = False


For intCol = 6 To 11 'Column F = 6
For lRow = 10000 To 9 Step -1 'Range row 10000 to 9
Set rngCell = Cells(lRow, intCol)
With rngCell
.Value = fn.Substitute(rngCell.Value, Chr(160), Chr(32)) 'accounts for space and no break space characters
.Value = Trim(rngCell.Value)
End With
If Len(rngCell) = 0 Then
rngCell.Delete Shift:=xlUp
End If
Set rngCell = Nothing
Next lRow
Next intCol
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

If Len(rngCell) = 0 Then
Intersect(rngCell.EntireRow, Range("A:K")).Delete shift:=xlUp
End If

 

[dvitale71]

That did the trick! Thank you!

How about

If Len(rngCell) = 0 Then
Intersect(rngCell.EntireRow, Range("A:K")).Delete shift:=xlUp
End If

 

[Fluff]

Glad to help & thanks for the feedback