VBA Code to cut and pasteto the bottom of same worksheet

[Dakwerd]

Hey everyone,

I'm new to VBA and trying to work out how to cut a row based on a single cells value and move it to the last row on the same worksheet. I'm also curious if this will cause some strange looping problem since that information would all be kept on one worksheet. No idea there.

I'm running Excel 2016 on a Microsoft 10 Pro.

Currently the information is presented as follows:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Last Name[/TD]
[TD]First Name[/TD]
[TD]Availability[/TD]
[TD]Stage Complete[/TD]
[TD]Location[/TD]
[/TR]
[TR]
[TD]Smith[/TD]
[TD]John[/TD]
[TD]Summer[/TD]
[TD]First Interview[/TD]
[TD]Los Angeles[/TD]
[/TR]
[TR]
[TD]Doe[/TD]
[TD]Jane[/TD]
[TD]Summer[/TD]
[TD]Archive[/TD]
[TD]Los Angeles[/TD]
[/TR]
</tbody>[/TABLE]


When the stage completed in row "D" becomes "Archive", I'd like there to be a button to move all the "Archive" rows to move to the bottom of the worksheet. Also to delete the row that it just left so there aren't gaps.

I keep finding all the individual components in other threads, and tried putting the code together from those, but couldn't get anything to work. Any guidance is very appreciated!

 

[JLGWhiz]

Give this a try

Sub t()
With ActiveSheet
    .Range("D1", .Cells(Rows.Count, 4).End(xlUp)).AutoFilter 1, "Archive"
    For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
        c.Resize(, 5).Cut .Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    .AutoFilterMode = False
    .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlShiftUp
End With
End Sub

 

[Dakwerd]

Give this a try

Sub t()
With ActiveSheet
    .Range("D1", .Cells(Rows.Count, 4).End(xlUp)).AutoFilter 1, "Archive"
    For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
        c.Resize(, 5).Cut .Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    .AutoFilterMode = False
    .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlShiftUp
End With
End Sub

I gave it a shot but came back with "Autofilter method of Range class failed" message. It had highlighted the first line.

I'm not sure what information I might still need to provide from the spreadsheet. The first row of info as actually on row 5. There are also some gaps along the way. I don't know if that changes anything.

 

[billandrew]

Not sure what the rest of your data looks like in Stage Complete Column- if it is Archive Items you wish on the bottom you can simply sort the column in descending order. When you change from "First Interview" to Archive the recently revised "Archive" item will go to the bottom of the First Interview data not the bottom of all the data.

Hope this helps.

Sub SortColumnD()Dim lr&
lr = Range("D" & Rows.Count).End(xlUp).Row
Range("A1:E" & lr).Sort Key1:=Range("D1"), order1:=xlDescending, Header:=xlYes
End Sub

 

[JLGWhiz]

Unless you have he data in a definge table, this should now work.

Sub t()
With ActiveSheet
    .Range("D5", .Cells(Rows.Count, 4).End(xlUp)).AutoFilter 1, "Archive"
    For Each c In .Range("A6", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
        c.Resize(, 5).Cut .Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    .AutoFilterMode = False
    .Range("D5", .Cells(Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlShiftUp
End With
End Sub

 

[Dakwerd]

It still didn't work for me. Got the same response.

I also forgot to mention that there are multiple tables on this worksheet. 8 to be accurate. Each one is for a different job position. So I can't just sort the column unfortunately.

I'm basically trying to move all the "Archive" from each table to the bottom table which is the archive table.

 

[billandrew]

Mr. Dakwerd

Like you I am learning VBA, I have below a Script which moves any rows in Column D in "Table1" [This can be changed as well] which are "Archive" to a table predetermined with the name Table_A. This can be changed to your table's name. This Script will work for only one Table to the Archive Table. If it works for you I can add additional Script for the other Tables in the worksheet. Be advised this is not the most efficient. I will continue to work on an alternative with a for each loop, however not sure how to exclude the Archive Table. Possibly one of our experts on the forum with come up with a better solution.

Sub MoveTableArchive()Dim Tbl1 As ListObject ' Table 1
Dim Archive_T As ListObject ' Archive Table
Dim Table1RowsCount&
Dim ArchiveRowscount&


Set Tbl1 = ActiveSheet.ListObjects("Table1")
Set Archive_T = ActiveSheet.ListObjects("Table_A")
On Error Resume Next
With Tbl1
    .Range.AutoFilter field:=4, Criteria1:="Archive"
    Table1RowsCount = .ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Count
    End With
With Archive_T
    ArchiveRowscount = .DataBodyRange.Rows.Count
    Tbl1.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
    .DataBodyRange.Cells(ArchiveRowscount + 1, 1).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
End With


With Tbl1
.DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range.AutoFilter
End With
End Sub

 

[JLGWhiz]

It still didn't work for me. Got the same response.

I also forgot to mention that there are multiple tables on this worksheet. 8 to be accurate. Each one is for a different job position. So I can't just sort the column unfortunately.

I'm basically trying to move all the "Archive" from each table to the bottom table which is the archive table.

You will need to spell out the table names that apply. Tables use a special vba syntax for ListObjects that is different than for normal data on a worksheet.