VBA - Cut and Paste from a table to another if criteria is met

[AlexSrois]

Hi Guys!

I've been trying to find a solution since quite a while, but nothing seems to work. I'm sure you can fin a easy solution for this :

In the same Workbook, I have two sheets ; Sheet1 and Sheet2. Both of them contains similar tables, Table1 in Sheet1, Table2 in Sheet2.

Table1 is the main table in which I input data and work on it. When I'm done, I mark Colum C with an "X". When I execute the command, I want to cut the data from Table1 into a new row into Table2.

All I can achieve at the moment is to delete the appropriate data from table1 using this code ;

Sub Archive()
' Erase date from table one and archive them in another sheet

'' 1) Warning Message
MsgBox "This is going to erase data marked with ''X'' in Table1" & vbCrLf & " " & " " & vbCrLf & "Are you sure you want to do that?", vbOKCancel

'' 2) Search for trigger (which is "X")
Sheets("Sheet1").Select
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
For I = lastRow To 1 Step -1
        If (Cells(I, "C").Value) = "X" Then

'' 3) Delete rows marked X
     Sheets("Sheet1").Cells(I, "C").EntireRow.Delete
        End If
Next I

End Sub

However, I cannot find any way to cut and paste to a new row into table2.

Any idea?

 

[Joe4]

What ranges exactly are these tables found in (rows/columns)?

 

[AlexSrois]

Hi Joe4, Thank you for taking the time to help me!

Tables are both from A1 to C7 right now, including a header. However they will grow as data is inserted (adding more row, keeping same number of column). If it's possible to add a new row directly to the table by referring to table1 and table2, that would probably be best, but not sure if it's possible in this case.

 

[Joe4]

Try this:

Sub Archive()
' Erase date from table one and archive them in another sheet

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim tbl2 As ListObject
Dim lastRow As Long
Dim I As Long
Dim r As Long

''Set first sheet
Set ws1 = Sheets("Sheet1")

''Specify location and name of table pasting data to
Set ws2 = Sheets("Sheet2")
Set tbl2 = ws2.ListObjects("Table2")

'' 1) Warning Message
MsgBox "This is going to erase data marked with ''X'' in Table1" & vbCrLf & " " & " " & vbCrLf & "Are you sure you want to do that?", vbOKCancel

'' 2) Search for trigger (which is "X")
ws1.Select
lastRow = Cells(Rows.Count, "C").End(xlUp).Row

For I = lastRow To 1 Step -1
        If ws1.Cells(I, "C").Value = "X" Then
        
'' 3) Insert blank row at bottom of table on Sheet 2 and copy row there
            ws2.Activate
            tbl2.ListRows.Add
            r = tbl2.Range.Rows.Count
            ws1.Activate
            ws1.Range(Cells(I, "A"), Cells(I, "C")).Copy ws2.Cells(r, "A")

'' 4) Delete rows marked X
            ws1.Cells(I, "C").EntireRow.Delete
        End If
Next I

End Sub

 

[AlexSrois]

That worked perfectly Joe4, thank you so much for your help.

Also, thank you for taking the time to put annotation in the code, this is gonna help me understand what you did to improve myself. I'm self taught with VBA and I often do not understand some of the basic stuff I should know before going more complex.

 

[Joe4]

You are welcome!
Glad I was able to help.

Yes, I usually like to document my code so hopefully people can understand the logic I am using.
Please feel free to ask if you have any questions about anything in my code.