PDA

View Full Version : Solved: Move Data Row To Fill Empty Row



hobbiton73
12-31-2012, 07:16 AM
Hi, I wonder whether someone could possibly help me please.

I'm using the code below to remove cell content from user selected row or rows.

Sub DelRow()
Dim msg

Sheets("Input").Protect "password", UserInterFaceOnly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Selection
Application.Intersect(.Parent.Range("A:R"), .EntireRow).Interior.ColorIndex = xlNone
Application.Intersect(.Parent.Range("S:AD"), .EntireRow).Interior.ColorIndex = 37
Application.Intersect(.Parent.Range("AF:AQ"), .EntireRow).Interior.ColorIndex = 42
Selection.SpecialCells(xlCellTypeConstants).ClearContents
End With
Application.EnableEvents = True

End Sub
The code works fine, but I'm having as little difficulty in amending to include the function where rows containing data move up to fill those that are empty, in essence moving the blank rows to the bottom of my 'Input Range'.

I've been trying to adapt the following code, which sorts the information but doesn't move the rows if preceeding rows are removed.

Private Sub BeforeClose(Cancel As Boolean)
Application.EnableCancelKey = xlDisabled
With Sheets("Input")
If .Range("A7").Value = "" Then
.Range("A7").End(xlDown).EntireRow.Cut .Range("A7")
End If
.Range("A7:AE400", "AF7:AQ400").Sort Key1:=Range("$B$1"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub
I just wondered whether someone may be able to look at this please, and offer some guidance on how I may go about changing this.

Many thanks and kind regards

Chris

hobbiton73
01-01-2013, 09:14 AM
Hi all, I just wanted to drop you a note to say that I've found a solution. I've been able to adapt the solution found here http://www.access-programmers.co.uk/forums/showthread.php?t=178521 so my final script is as follows:


Sub DelRow()
Dim msg

Sheets("Input").Protect "handsoff", UserInterFaceOnly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Selection
Application.Intersect(.Parent.Range("A:R"), .EntireRow).Interior.ColorIndex = xlNone
Application.Intersect(.Parent.Range("S:AD"), .EntireRow).Interior.ColorIndex = 37
Application.Intersect(.Parent.Range("AF:AQ"), .EntireRow).Interior.ColorIndex = 42
Selection.SpecialCells(xlCellTypeConstants).ClearContents
End With
Application.EnableEvents = True
With Range("A7:AS400" & Cells(Rows.Count, "A").End(xlUp).Row)
.Sort Key1:=Range("B7"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With

End Sub

Many thanks for all your help.

Kind regards

Chris