Move Row to New Worksheet Based on Cell Value Matching a Value from a Table

[guyatwork37]

Similar Variations of this question have been asked but I have been unable to fine one for my exact purpose. I'd like to move the row from a worksheet in to one of 5 different worksheets, if the value in a column matches a value in another worksheet. In this example I have a sheet called "Opportunities" where data resides. I have another sheet called "State List" which lists the different states in one column and a person's name in another column. There are 5 worksheets that match the 5 different names in the "State List" worksheet. If the "Opportunities" sheet has a state, I'd like that row to be moved to the worksheet that matches the name of the person associated with that state on the "State List" sheet. Is that possible? I've been able to code specific state names to a specific sheet, but not an automated range lookup. Any help would be appreciated! Thank you!

 

[Fluff]

Hi & welcome to MrExcel.
A few questions
1) Whereabouts in the State List sheet are the states & the names?
2) Where on the Opportunities sheet is the state?
3) Do you want to run this from a button, or have it work automatically when a specific column is changed?

 

[guyatwork37]

Hi & welcome to MrExcel.
A few questions
1) Whereabouts in the State List sheet are the states & the names?
2) Where on the Opportunities sheet is the state?
3) Do you want to run this from a button, or have it work automatically when a specific column is changed?

1) On the "State List" sheet, the names are in column A and states are in column B.
2) On the "Opportunities" sheet, the state is listed in column J
3) Run from a button

Thank you so much!

 

[Fluff]

Ok, how about

Sub guyatwork()
   Dim Dic As Object
   Dim Cl As Range
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("State List")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         Dic(Cl.Offset(, 1).Value) = Cl.Value
      Next Cl
   End With
   With Sheets("Opportunities")
      For i = 0 To Dic.count - 1
         .Range("A1:J1").AutoFilter 10, Dic.Keys()(i)
         .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(Dic.Items()(i)).Range("A" & Rows.count).End(xlUp).Offset(1)
      Next i
      .AutoFilterMode = False
   End With
End Sub

 

[guyatwork37]

Ok, how about

Sub guyatwork()
   Dim Dic As Object
   Dim Cl As Range
   Dim i As Long
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("State List")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         Dic(Cl.Offset(, 1).Value) = Cl.Value
      Next Cl
   End With
   With Sheets("Opportunities")
      For i = 0 To Dic.count - 1
         .Range("A1:J1").AutoFilter 10, Dic.Keys()(i)
         .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(Dic.Items()(i)).Range("A" & Rows.count).End(xlUp).Offset(1)
      Next i
      .AutoFilterMode = False
   End With
End Sub

That is absolutely perfect. Thank you so much!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[scarrain]

You're welcome & thanks for the feedback

You're welcome & thanks for the feedback.

Fluff,

I found this thread and used your code in my own workbook making the required changes to the Sheet numbers and value it worked amazing thank you! But I was wondering if it is possible to modify this slightly to reference a list in my workbook for the Value and move rows based on the list Values. The list is currently on a separate tab called DATA in cells C1 to C5

Sub HOLDS()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Report").UsedRange.Rows.Count
J = Worksheets("HOLD").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("HOLD").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Report").Range("AE1:AE" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "B7KB00" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("HOLD").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "B7KB00" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Fluff]

The code you have posted is nothing like the code I posted.

if it is possible to modify this slightly to reference a list in my workbook for the Value and move rows based on the list Values.

That's exactly what my code does.

 

[scarrain]

You are correct I apologize I had several threads open and thought this had originated here.

Thank you for your response.