VBA Delete Shift:=xlUp Alternative (Looking For A Different Method That Doesn't Destroy Formatting)

[figuare9]

This is a snippet of what I have, but I'm looking for another method that won't ruin formatting on a table.

Dim es As Worksheet, WSC As Worksheet
Set es = Worksheets("Master Employee List")
Set WSC = Worksheets("Testme")


r = Application.Match(emp, es.Range("A:A"), 0)
es.Rows(r).Delete Shift:=xlUp


i = Application.Match(emp, WSC.Range("B:B"), 0)
WSC.Rows(i).Delete Shift:=xlUp
MsgBox emp

Basically, this method is deleting the row. So if I have a table outline that has borders, and formatting, when it deletes the row, the table gets smaller every time. What I would like to do is clear the row data, and move everything below it up without actually removing the row.

The only method in my head I see working would be to insert a row above the match, and then remove it? Just wondering if there's an easier way.

 

[Yongle]

How about moving the row to the bottom of the table and then deleting the values, like this

Sub testCutRow()
    Rows(r).Cut
    Rows(Range("A" & Rows.Count).End(xlUp).Offset(1).Row).Insert
    Rows(Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End Sub

Add sheet references etc to match your requirements

 

[figuare9]

Think we're getting close with that.. That way is unfortunately killing my formatting though, and I can't seem to get it to delete (yet) from the bottom where it inserts the data

Sub Delete_employee()On Error Resume Next
Set myRange = Application.InputBox(Prompt:="Please click on the Employee you want to remove", _
Title:="Click on employee", Type:=8)
r1 = myRange.Row
c1 = myRange.Column
If myRange Is Nothing Then Exit Sub
emp = Cells(r1, c1).Value


x = InputBox("This action CANNOT be undone! Type YES to delete  - " & emp)
If UCase(x) <> "YES" Then
    MsgBox "Employee NOT deleted"
    Exit Sub
End If


Dim es As Worksheet, etd As Worksheet
Set es = Worksheets("Master Employee List")
Set etd = Worksheets("Jan Week 1")


r = Application.Match(emp, es.Range("A:A"), 0)
es.Rows(r).Delete Shift:=xlUp


i = Application.Match(emp, etd.Range("D:D"), 0)
[COLOR=#ff0000]etd.Rows(i).Cut
etd.Rows(Range("D" & Rows.Count).End(xlUp).Offset(55).Row).Insert
etd.Rows(Range("D" & Rows.Count).End(xlUp).Row).ClearContents[/COLOR]


'WORKING OLD
'etd.Rows(i).Delete Shift:=xlUp
MsgBox emp


Call Fill_it


End Sub

I got it going to the end of the table, but it's just inserting the data towards the bottom and filling up from the bottom going up.

I'm going to experiment..


Looks like the last line isn't working where the clear contents are.

Rows(Range("A" & Rows.Count).End(xlUp).Row).ClearContents

 

[figuare9]

Got it working with this..

i = Application.Match(emp, etd.Range("D:D"), 0)etd.Rows(i).Cut
etd.Rows(Range("D" & Rows.Count).End(xlUp).Offset(55).Row).Insert
etd.Rows(Range("D55").Row).ClearContents

So I'm cutting the row, then inserting that row at the bottom, then clearing it. Works for me! ha.. Now if I can fix this formatting issue so everything stays the same I'll be in business!!