VBA to move data from one sheet to another when condition met

[jpc2023]

I have a workbook with a sheet called "In Use" where my current data is, spanning columns A through O. In column O, I will enter "yes" when the row is complete and would like this to signal that the row's data should move into another sheet in the same workbook called "Old Reagents". I'd like the data to be deleted from "In Use" when it is moved to "Old Reagents". Both sheets have the same columns and headers A through O.

I've tried but cannot come up with the correct worksheet and module codes to make this work. Can anyone help? I'm a novice Excel user so simple language is appreciated!

 

[Herakles]

Hi jpc2023

Welcome to Mr Excel.

Try this code.

I did not know how you wanted this process triggered so I've put it in the Worksheet Activate event for the Old Reagents worksheet.

When you activate this sheet a count will be made of the number of rows to transfer and you will be asked if you want to transfer them
if appropriate.

If you wanted it triggered differently then please let me know.

Try it on a copy of your data.

Private Sub Worksheet_Activate()
Dim arr() As Variant
Dim i As Integer
Dim lngCount As Long

    ActiveWorkbook.Save
    
    lngCount = WorksheetFunction.CountIf(Worksheets("In Use").Range("A1").CurrentRegion.Columns(15), "yes")
    
    If lngCount = 0 Then
        Exit Sub
    End If
    
    If MsgBox("Transfer " & lngCount & " rows to this worksheet?", vbYesNo, "Data Transfer") = vbNo Then
        Exit Sub
    End If
    
    arr = Worksheets("In Use").Range("A1").CurrentRegion.Columns(15).Value
    
    For i = UBound(arr, 1) To 2 Step -1
        If Worksheets("In Use").Range("O" & i).Value = "yes" Then
            With Worksheets("Old Reagents")
                .Range("O" & i).EntireRow.Copy Destination:=.Range("A1").Offset(.Range("A1").CurrentRegion.Rows.Count, 0)
                Worksheets("In Use").Range("O" & i).EntireRow.Delete
            End With
        End If
    Next i
    
End Sub

 

[jpc2023]

Thanks! I put the code in but I am not sure I did it correctly... it does ask me if I want to transfer the rows, but when I click "yes" it deletes it from the "In Use" tab but doesn't transfer it over to the "Old Reagents" tab.

In my original post, I was wanting the rows to automatically move to the other sheet when the "yes" was entered, but I really like the way you did it with the popup. I think that is better.

I originally found this post that is very similar to what I want to do, but I could not figure out how to make it work for me having only one sheet the data needs to end up in ("Old Reagents") vs. theirs having 12 for the months: How to move data from one sheet to another if a condition is met in case this helps?

 

[Herakles]

Have you got the column headings in the "Old Reagents" tab?

 

[Herakles]

Give this a try.

I sussed out where it was going wrong.

Apologies for that.

Private Sub Worksheet_Activate()
Dim arr() As Variant
Dim i As Integer
Dim lngCount As Long

    ActiveWorkbook.Save
    
    lngCount = WorksheetFunction.CountIf(Worksheets("In Use").Range("A1").CurrentRegion.Columns(15), "yes")
    
    If lngCount = 0 Then
        Exit Sub
    End If
    
    If MsgBox("Transfer " & lngCount & " rows to this worksheet?", vbYesNo, "Data Transfer") = vbNo Then
        Exit Sub
    End If
    
    arr = Worksheets("In Use").Range("A1").CurrentRegion.Columns(15).Value
    
    For i = UBound(arr, 1) To 2 Step -1
        If Worksheets("In Use").Range("O" & i).Value = "yes" Then
            With Worksheets("Old Reagents")
                Worksheets("In Use").Range("O" & i).EntireRow.Copy Destination:=.Range("A1").Offset(.Range("A1").CurrentRegion.Rows.Count, 0)
                Worksheets("In Use").Range("O" & i).EntireRow.Delete
            End With
        End If
    Next i
    
End Sub

 

[jpc2023]

It does copy them over now, but it just rewrites them on top of each other on the same row (row 4). It happens regardless if I say "yes" for multiple rows at once and then click over to "Old Reagents" tab, or if I do them one at a time. (Not sure if this matters, but my headers are on rows 1 and 2 of each sheet, so line 3 is where the data begins.)

 

[vcoolio]

Hello JPC,

Here's another option. It's a Worksheet_Change event code so the code will execute when you enter "Yes" and click away.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wsOR As Worksheet: Set wsOR = Sheets("Old Reagents")
    
    If Intersect(Target, Columns(15)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
        If Target.Value = "Yes" Then
                Target.EntireRow.Copy wsOR.Range("A" & Rows.Count).End(3)(2)
                Target.EntireRow.Delete
        End If
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

I've not included message boxes in the code.

To implement this code:
- Right click on the "In Use" sheet tab.
- Select "View Code" from the menu that appears.
- In the big white code field that then appears, paste the above code.

Test the code in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.

 

[jpc2023]

That seems to be mostly working! The only problem is if there's nothing in the "Old Reagents" sheet yet, then whatever gets moved over gets put in the wrong spot... I'm assuming it may have something to do with the fact that my sheet headers are in rows 1 and 2, and filtering on my columns?

I've included a screen shot showing my first line that was supposed to transfer - looks like it tried to put it in row 2 but only a couple fields w/o filters show the data (also included what my "In Use" sheet looks like). Is there a way to make it start in row 3?

 

[vcoolio]

Hello JPC,

To whom are you referring?

Cheerio,
vcoolio.

 

[Tom.Jones]

That seems to be mostly working! The only problem is if there's nothing in the "Old Reagents" sheet yet, .....

You work with merged cells.