Hi, Can someone please help me with following. Need a macro to remove random blank rows in the column R in the sheet “sheet2”. Once the blank rows removed, add alternate blank rows so that the final result is non blank rows separated by a single blank row. Thank you,
-
If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
Remove random blanks and add alternate empty rows.
- Thread starter topi1
- Start date
Artik
Active Member
- Joined
- Jun 5, 2012
- Messages
- 286
e.g.
Artik
VBA Code:
Sub RemoveAndInsertRows()
Dim rngUnion As Range
Dim rngSource As Range
Dim lRow As Long
Dim rngCell As Range
Dim i As Long
lRow = GetLastCell(ActiveSheet.UsedRange, xlByRows).Row
Set rngSource = Range("R1", Cells(lRow, "R"))
For Each rngCell In rngSource.Cells
If IsEmpty(rngCell.Value) Then
If Not rngUnion Is Nothing Then
Set rngUnion = Union(rngUnion, rngCell)
Else
Set rngUnion = rngCell
End If
End If
Next rngCell
If Not rngUnion Is Nothing Then
rngUnion.EntireRow.Delete
End If
For i = rngSource.Rows.Count To 2 Step -1
Rows(i).Insert
Next i
End Sub
Function GetLastCell(InRange As Range, SearchOrder As XlSearchOrder, _
Optional ProhibitEmptyFormula As Boolean = False) As Range
' By Chip Pearson, www.cpearson.com
Dim WS As Worksheet
Dim R As Range
Dim LastCell As Range
Dim LastR As Range
Dim LastC As Range
Dim SearchRange As Range
Dim LookIn As XlFindLookIn
Dim RR As Range
Set WS = InRange.Worksheet
If ProhibitEmptyFormula = False Then
LookIn = xlFormulas
Else
LookIn = xlValues
End If
Select Case SearchOrder
Case XlSearchOrder.xlByColumns, XlSearchOrder.xlByRows, _
XlSearchOrder.xlByColumns + XlSearchOrder.xlByRows
' OK
Case Else
Err.Raise 5
Exit Function
End Select
With WS
If InRange.Cells.Count = 1 Then
Set RR = .UsedRange
Else
Set RR = InRange
End If
Set R = RR(RR.Cells.Count)
If SearchOrder = xlByColumns Then
Set LastCell = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False)
ElseIf SearchOrder = xlByRows Then
Set LastCell = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False)
ElseIf SearchOrder = xlByColumns + xlByRows Then
Set LastC = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False)
Set LastR = RR.Find(what:="*", after:=R, LookIn:=LookIn, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False)
Set LastCell = Application.Intersect(LastR.EntireRow, LastC.EntireColumn)
Else
Err.Raise 5
Exit Function
End If
End With
Set GetLastCell = LastCell
End Function
Upvote
0
Thank you so much. It works but sometimes it is erratic and does not clean up between last two entries. For example, see the large gap between h and i in the following example. TY so much.
| Book1 | |||
|---|---|---|---|
| K | |||
| 1 | a | ||
| 2 | |||
| 3 | b | ||
| 4 | |||
| 5 | c | ||
| 6 | |||
| 7 | 3 | ||
| 8 | |||
| 9 | 4 | ||
| 10 | |||
| 11 | d | ||
| 12 | |||
| 13 | 5 | ||
| 14 | |||
| 15 | e | ||
| 16 | |||
| 17 | 6 | ||
| 18 | |||
| 19 | g | ||
| 20 | |||
| 21 | h | ||
| 22 | |||
| 23 | |||
| 24 | |||
| 25 | |||
| 26 | |||
| 27 | i | ||
Sheet2 | |||
Upvote
0
Thank you so much. It works but sometimes it is erratic and does not clean up between last two entries. For example, see the large gap between h and i in the following example. TY so much.
Sorry for the confusion. I ran the code in 365 but had not activated XL2Bb so copied in to 2010 version and sent. Sorry for the confusion.
Upvote
0
Similar threads
