Move Row to Another Sheet Based on Multiple Cell Values

[winterprince]

Hi there!

I'm trying to create a macro to move an entire row from one worksheet to another based on the cell values in multiple columns. I've tried messing with a few macros I've found online, but can't get it to work.

You can see the attached image for reference. Essentially, I want to move an entire from Group 1 to Group 2 if they meet three criteria (have to meet all three):
1. They do NOT have a relationship manager (cell is blank)
2. The program is Unrestricted
3. The sale type is One Time

Also the Group 2 sheet has a header row.

Can anyone help me out?

 

[Trebor76]

Hi winterprinces,

Welcome to the forum.

As long as you don't have thousands of records this will do the job:

Option Explicit
Sub Macro1()

    Dim i As Long, j As Long, k As Long
    Dim wsGrp1 As Worksheet, wsGrp2 As Worksheet
   
    Application.ScreenUpdating = False
   
    Set wsGrp1 = ThisWorkbook.Sheets("Group 1")
    Set wsGrp2 = ThisWorkbook.Sheets("Group 2")
   
    j = wsGrp1.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
           
    For i = j To 2 Step -1
        If Len(wsGrp1.Range("B" & i)) = 0 And StrConv(wsGrp1.Range("C" & i), vbUpperCase) = "UNRESTRICTED" And StrConv(wsGrp1.Range("D" & i), vbUpperCase) = "ONE TIME" Then
            k = wsGrp2.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsGrp2.Range("A" & k & ":D" & k).Value = wsGrp1.Range("A" & i & ":D" & i).Value
            wsGrp1.Range("A" & i).EntireRow.Delete
        End If
    Next i
   
    Application.ScreenUpdating = True

End Sub

Let us know if the dataset is very large and we can have a look at other ways.

Regards,

Robert

 

[jolivanes]

Sub Like_So()
Dim lc As Long, lr1 As Long, lr2 As Long
lc = Sheets("Group 1").Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lr1 = Sheets("Group 1").Cells.Find("*", , , , xlByRows, xlPrevious).Row
lr2 = Sheets("Group 2").Cells(Sheets("Group 2").Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
    Sheets("Group 1").Range("A1:D" & lr1).AutoFilter 2, "="
    Sheets("Group 1").Range("A1:D" & lr1).AutoFilter 3, "Unrestricted"
    Sheets("Group 1").Range("A1:D" & lr1).AutoFilter 4, "One Time"
    Sheets("Group 1").Range("A2:A" & lr1).Resize(, lc).Copy Sheets("Group 2").Cells(lr2, 1)
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Trebor76]

Hi jolivanes,

Nifty code I just think the lr2 variable should be as follows or else it copy over the headings in the Group 2 tab when the fitters results are copied over:

lr2 = Sheets("Group 2").Cells(Sheets("Group 2").Rows.Count, 1).End(xlUp).Row + 1

Thanks,

Robert

 

[jolivanes]

Hi Robert.
You're right. Forgot to put the +1 in it.
Thank you.

 

[winterprince]

Hi winterprinces,

Welcome to the forum.

As long as you don't have thousands of records this will do the job:

Option Explicit
Sub Macro1()

    Dim i As Long, j As Long, k As Long
    Dim wsGrp1 As Worksheet, wsGrp2 As Worksheet
  
    Application.ScreenUpdating = False
  
    Set wsGrp1 = ThisWorkbook.Sheets("Group 1")
    Set wsGrp2 = ThisWorkbook.Sheets("Group 2")
  
    j = wsGrp1.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
          
    For i = j To 2 Step -1
        If Len(wsGrp1.Range("B" & i)) = 0 And StrConv(wsGrp1.Range("C" & i), vbUpperCase) = "UNRESTRICTED" And StrConv(wsGrp1.Range("D" & i), vbUpperCase) = "ONE TIME" Then
            k = wsGrp2.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsGrp2.Range("A" & k & ":D" & k).Value = wsGrp1.Range("A" & i & ":D" & i).Value
            wsGrp1.Range("A" & i).EntireRow.Delete
        End If
    Next i
  
    Application.ScreenUpdating = True

End Sub

Let us know if the dataset is very large and we can have a look at other ways.

Regards,

Robert

This did the trick! Thank you so much, this is a huge timesaver. It's a big help operationally and I learned a lot by going through the code. Thank you!

 

[Trebor76]

This did the trick! Thank you so much, this is a huge timesaver. It's a big help operationally and I learned a lot by going through the code. Thank you!

Thanks for the feedback and you're welcome .

Make sure to try jolivanes's code as he would have spent some time putting it together and it's actually more efficient than mine as it doesn't loop.

Regards,

Robert

 

[jolivanes]

Quite a few people seem to focus on one piece of code. It might be because it looks better/easier for them. I have no problem with that of course but I do sometimes find it very impolite to not acknowledge other peoples efforts and time. This seems to be becoming pretty standard.
Thanks for reminding the OP to look past the one macro.

 

[winterprince]

Quite a few people seem to focus on one piece of code. It might be because it looks better/easier for them. I have no problem with that of course but I do sometimes find it very impolite to not acknowledge other peoples efforts and time. This seems to be becoming pretty standard.
Thanks for reminding the OP to look past the one macro.

Hey Jolivanes I appreciate your help! I did in fact "heart" your response, so I felt that I had acknowledged it. I'm working on a time sensitive project, so when I found a solution that worked, I ran with it!

Please don't rush to judgements - I meant no harm. I'm brand new member of this forum, so if I acted out of decorum, I didn't know. Again, thank you and keep on sharing your skills! I know it's a big help.

 

[jolivanes]

Thanks for the clarification and good luck.