Question

I wonder whether someone could possibly help me please.

So that I can maintain a given ‘Input Range’ I’m trying to put together a script which removes cell content from user selected row or rows. Then move all rows with data to the top of my spreadsheet if column “A” starting from row 7 is populated.

I’ve put together the code below which removes the cell content from the row, but I can’t work out how to move the ‘Shift Up’ the rows containing data to sit one under another, omitting any blank rows between the data.

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

I’ve put together a ‘Sort’ macro shown below, and although this works with two consecutive rows containing data, it does not work for rows that I have used my ‘Delete’ macro on.

For example, if I populate the first and second row of my ‘Input Range’, the code correctly sorts the spreadsheet using column “B” as the sort criteria. But if I remove the content of the first row, hence creating a blank row, the ‘Sort’ script does not shift up the second row.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.EnableCancelKey = xlDisabled
    With Sheets("Input")
        If .Range("A7").Value = "" Then Exit Sub
        .Range("B7:AS400").Sort Key1:=Range("$B$1"), _
        Order1:=xlAscending, _
        Header:=xlGuess, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DatOption1:=xlSortNormal
    End With
End Sub

I just wondered whether someone could possibly take a look at this please and offer some guidance on how I need to adapt my code so that I can add the sort functionality.

Many thanks and kind regards

Answer 1

Following more searching on the internet, I found the following article:
http://www.access-programmers.co.uk/forums/showthread.php?t=178521

Using this, I’ve amended my ‘Delete Row’ code to the following which works perfectly:

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

Thank you very much to all who have been kind enough to offer help.

Many thanks and a very happy New Year.

Kind regards