CODEWITHSUNDEEP
excelvba
Raghav Chamadiya
Raghav Chamadiya

Reputation: 240

Shift the row values up in excel using macro after a row is deleted

So, I am using this macro to search by id(serial number) and then the delete the row elements for that particular row. The code for deleting the row is:

Sub DeleteMe()
'declare the variables
Dim ID As Range, c As Range, orange As Range
Dim wb As Workbook
Set wb = ThisWorkbook
Set Fws = wb.Sheets("Data")
Set Bws = wb.Sheets("Bookings")
Dim lastrow As Long
'set the object variable
Set ID = Bws.Range("B3")
'stop screen flicker
Application.ScreenUpdating = False
lastrow = Fws.Range("A" & Rows.Count).End(xlUp).Row
Set orange = Fws.Range("A2:A" & lastrow)
'find the value in the range
For Each c In orange
    If c.Value = ID.Value Then
'delete the row
        c.Cells(1, 2).Clear
        c.Cells(1, 3).Clear
        c.Cells(1, 4).Clear
        c.Cells(1, 5).Clear
        c.Cells(1, 6).Clear
        c.Cells(1, 7).Clear
        c.Cells(1, 8).Clear
        c.Cells(1, 9).Clear
        c.Cells(1, 10).Clear
        c.Cells(1, 11).Clear
        c.Cells(1, 12).Clear
        c.Cells(1, 13).Clear
        c.Clear

    End If

Next c

Sheet2.Select

End Sub

I am not deleting the entire row because There are values in further columns which I don't want to touch

After the code is run, my database looks like this: enter image description here

What I want is to shift all the remaining rows up to fill the empty row. I also want the serial numbers to change accordingly. So in this case 7 will become 6 and 8 will become 7.

Thanks in advance!

Upvotes: 0

Views: 857

Answers (2)

Naresh
Naresh

Reputation: 3034

Try This .. Looping upward helps to ensure all rows are covered. Because if we loop downward once we delete a row then the next row number becomes i -1

Sub DeleteMe()
'declare the variables
Dim Fws As Worksheet, Bws As Worksheet
Dim ID As Range
Dim wb As Workbook
Set wb = ThisWorkbook
Set Fws = wb.Sheets("Data")
Set Bws = wb.Sheets("Bookings")
Dim lastrow As Long
'set the object variable
Set ID = Bws.Range("B3")
'stop screen flicker
Application.ScreenUpdating = False
lastrow = Fws.Range("A" & Rows.Count).End(xlUp).Row
'find the value in the range
Fws.Select
For i = lastrow To 2 Step -1
    If Fws.Cells(i, 1) = ID.Value Then
'delete the row
        Fws.Range(Cells(i, 1), Cells(i, 13)).Delete Shift:=xlUp
    End If
Next

With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    .Formula = "=ROW() - 1"
    .Value = .Value
End With

End Sub

Upvotes: 1

Variatus
Variatus

Reputation: 14383

Please try this code. It should do what you want.

Sub DeleteMe()
    ' 018

    'declare the variables
    Dim Wb As Workbook
    Dim Fws As Worksheet, Bws As Worksheet
    Dim DelRng As Range
    Dim Id As String
    Dim Rl As Long                              ' last row
    Dim R As Long                               ' row counter

    'set the object variables
    Set Wb = ThisWorkbook
    Set Fws = Wb.Sheets("Data")
    Set Bws = Wb.Sheets("Bookings")

    'stop screen flicker
    Application.ScreenUpdating = False

    Set Id = Bws.Range("B3")
    With Fws
        ' loop through all cells from bottom to top
        ' because row numbers will change as you delete cells
        For R = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
            'find the value in each row
            If .Cells(R, "A").Value = Id.Value Then
                Set DelRng = .Range(.Cells(R, 1), .Cells(R, 13))
                DelRng.Delete Shift:=xlUp
            End If
        Next R

        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        For R = 2 To Rl
            .Cells(R, "A").Value = R - 1
        Next R
    End With
End Sub

Upvotes: 1

Related Questions