VBA Coding - Move complete row to another sheet based on a Criteria in a Cell.

ClarkeJosh

New Member
Joined
Dec 23, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
I have looked through the threads an unable to find the answer, hoping someone can help me rectify the error in my VBA coding,
I have 2 sheets one labeled as Actions and one Labeled as Completed.
In actions sheet when the data in Column K is "Complete" i would like to move the whole row to Sheet "Completed"

Below is the coding i am using, but when i run the macro i get the error " Compile Error" Invalid Outside Procedure.

Any assistance rectifying the error would be greatly appreciated.

Coding im usung is:

Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Sheet1").UsedRange.Rows.Count
B = Worksheets("Sheet2").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Actions").Range("C1:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(C).Value) = "Complete" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Complete" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Have also tried this withing Module 1

Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Action").Range("K8:K" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Done" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Done" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End
 
Upvote 0
Try this approach. Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Actions sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter "Complete" in any cell in column K and press the RETURN key or TAB key. That row will be automatically copied to the "Completed" sheet and deleted from the "Action" sheet.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    If Target = "Complete" Then
        Target.EntireRow.Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
        Rows(Target.Row).Delete
    End If
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
Try this approach. Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Actions sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter "Complete" in any cell in column K and press the RETURN key or TAB key. That row will be automatically copied to the "Completed" sheet and deleted from the "Action" sheet.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    If Target = "Complete" Then
        Target.EntireRow.Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
        Rows(Target.Row).Delete
    End If
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Thanks i have copied this code and it works well, i now have hit another snag, we would like to have the rows changed to complete, but not move to additional sheet until we click on a button that we will label as COMPLETE... any assistance having the coding work with a button click would be appreciated.
 
Upvote 0
Delete the previous macro and place this macro in a regular module and assign it to your button.
VBA Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Sheets("Completed").UsedRange.Offset(1).ClearContents
    With Sheets("Actions")
        .Range("A1").CurrentRegion.AutoFilter 11, "Complete"
        .AutoFilter.Range.Offset(1).Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Delete the previous macro and place this macro in a regular module and assign it to your button.
VBA Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Sheets("Completed").UsedRange.Offset(1).ClearContents
    With Sheets("Actions")
        .Range("A1").CurrentRegion.AutoFilter 11, "Complete"
        .AutoFilter.Range.Offset(1).Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub
Thanks for the code, i have assigned it to a button however when ever i run the macro i get the error Runtime error 1004 : We cant do that to a merged cell.. the spreadsheet has a heading that is in merged cells ranging from A1:L5. I would like to keep the cells merged and the data is input into Cells A8 onwards, is there a simple coding change that is needed for this to happen.
I did unmerge the cells in both Actions sheet and Completed sheets and was then getting the Runtime Error 1004 : AutoFilter method range Class Failed.
 
Upvote 0
Thanks for the code, i have assigned it to a button however when ever i run the macro i get the error Runtime error 1004 : We cant do that to a merged cell.. the spreadsheet has a heading that is in merged cells ranging from A1:L5. I would like to keep the cells merged and the data is input into Cells A8 onwards, is there a simple coding change that is needed for this to happen.
I did unmerge the cells in both Actions sheet and Completed sheets and was then getting the Runtime Error 1004 : AutoFilter method range Class Failed.
I unmerged the cells A1:L5 on the "Completed" Sheet where i want the information to move to and then managed to have the data moved, however when i enter in new data, and click the button, the new data overwrites the old data, ideally i would like the data to remain old and new, and have the first 5 rows merged for the heading. is there something that need to change for the data to commence in row 7 and for the old data to remain and the new data to be copied into vacant cells underneath.
 
Upvote 0
Try:
VBA Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Completed").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With Sheets("Actions")
        .Range("A1").CurrentRegion.AutoFilter 11, "Complete"
        If LastRow < 7 Then
            .AutoFilter.Range.Offset(1).Copy Sheets("Completed").Range("A7")
        Else
            .AutoFilter.Range.Offset(1).Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
        End If
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top