How can I fix the slipped rows in excel by VBA? - vba

Question

I have an excel file which includes a lot of rows. Every second rows are slipped. How can I fix these slipped rows by VBA?
I have attached a little template:
And what can I do if the blank cells are there on the right side?

Answer 1

Here is the VBA version of my comment with shift to left:
Range("A:A").SpecialCells(xlCellTypeBlanks).Delete xlShiftToLeft
There is no shift to right delete, but there are few ways around it depending on the layout. A more general approach can be to move the blank cells selection to the left and use insert shift to right, but I am not sure how to do that without VBA.
For example, selecting the blank cells in column F and inserting the corresponding cells on the same rows in column A:
Intersect(Range("A:A"), Range("F:F").SpecialCells(xlCellTypeBlanks).EntireRow).Insert xlShiftToRight
A more general approach for more random blank areas is to shift each row separately:
With ActiveCell.Worksheet.UsedRange ' or change to a different range
.SpecialCells(xlCellTypeBlanks).Delete xlShiftToLeft ' to shift all non-blank cells to the left
For Each area In .SpecialCells(xlCellTypeBlanks).Areas
area.Offset(, .Column - area.Column).Insert Shift:=xlToRight
Next
End With

Answer 2

Assumes data in columns A to F
Sub Main()
Dim rng As Range, cl As Range
Set rng = Range("B1:B" & Range("B1").End(xlDown).Row)
For Each cl In rng
If cl.Offset(0, -1) = vbNullString Then
Range(Cells(cl.Row, cl.Column), Cells(cl.Row, 6)).Cut Destination:=cl.Offset(0, -1)
End If
Next cl
End Sub

Answer 3

try this:
Sub slipp_fix()
Set ww = Application.Selection
Set ww = Application.InputBox("Select first col of table", xTitleId, ww.Address, Type:=8)
For Each C In ww
If C.Value = "" Then
C.Select
Selection.Delete Shift:=xlToLeft
End If
Next
end sub