VBA code to move row to new worksheet based upon cell value - then delete

[chefpolo]

Hi,

I need some help writing code that would move each row in worksheet overview to the corresponding worksheet based upon the value in column J and keep the column headers. The values in column J are the same as the worksheets. I then would need this row to delete.

Would it also be possible to include some sort of validation that would search the file for existing entries with the same name? For instance as shown I have entry for Marco Rossi - once I run the code and the row gets exported to closed. if I input a new Marco Rossi - can you have the file tell me there is already an entry for marco rossi in x worksheet?

See picture attached

 

[DanteAmor]

I need some help writing code that would move each row in worksheet overview to the corresponding worksheet based upon the value in column J and keep the column headers. The values in column J are the same as the worksheets.

According to your image it should be column K

For the above, put the following code in a module.

Sub create_worksheets()
  Dim c As Range, sh As Worksheet, ky As Variant
  
  Application.ScreenUpdating = False
  Set sh = Sheets("Overview")
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("K2", sh.Range("K" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      If Evaluate("ISREF('" & ky & "'!A1)") Then
        sh.Range("A1").AutoFilter Columns("K").Column, ky
        sh.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(ky).Range("A" & Rows.Count).End(3)(2)
        sh.AutoFilter.Range.Offset(1).EntireRow.Delete
      End If
    Next ky
  End With
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
End Sub

---

Would it also be possible to include some sort of validation that would search the file for existing entries with the same name?

For that put the following code in the events of the sheet "Overview"

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range
  Dim sh As Worksheet
  Dim fname As String
  
  Set rng = Intersect(Target, Range("B2:C" & Rows.Count))
  If Not rng Is Nothing Then
    For Each c In rng
      fname = Range("D" & c.Row).Value
      If fname <> "" Then
        For Each sh In Sheets
          If sh.Name <> ActiveSheet.Name Then
            Set f = sh.Range("D:D").Find(fname, , xlValues, xlWhole, , , False)
            If Not f Is Nothing Then
              MsgBox "There is already an entry for " & fname & " in " & sh.Name & " worksheet"
              c.Select
              Exit Sub
            End If
          End If
        Next
      End If
    Next
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet (overview sheet) you want this to work, select view code and paste the code into the window that opens up.

 

[chefpolo]

thank you so much - i did the following but for some reason the debugger comes up. Im getting the following: Run-time error '1004': Application-defined or object defined error

See image for code:

 

[DanteAmor]

Something different in your data or in your sheets, from what is shown in your image?
Cells with error, hidden or protected sheets?

 

[chefpolo]

Nothing hidden or protected. Column D does have concat function and Column N has a simple subtraction function. and data validation in columns F and K.

 

[chefpolo]

HR Tracker - Sample.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	LOCATION	FIRST	LAST NAME	Full Name	DEPT	ACTION	DATE	SHORT SUMMARY NOTES	NEXT STEPS (if any)	NEXT STEP DUE DATE (if any)	Status	QUICK NOTES (if any)	Date of closed	Total amount of time
2	EDT	Marco	Rossi	Marco Rossi		A	1/1/2022	blabla	blabla	1/5/2022	In progress (HR)		1/10/2022	9.00
3	ECH	John	Doe	John Doe		A	1/1/2022	blabla	blabla	1/5/2022	Closed		1/10/2022	9.00
4	EDA	Mary	Doe	Mary Doe		A	1/1/2022	blabla	blabla	1/5/2022	Action from 3rd party needed		1/10/2022	9.00
5	ELA	Susan	Doe	Susan Doe		A	1/1/2022	blabla	blabla	1/5/2022	In progress (HR)		1/10/2022	9.00
6
7
8
9
10
11
12
13
14
15
16
17
18
Overview

Cell Formulas
Range	Formula
N2:N5	N2	=M2-G2

Cells with Data Validation
Cell	Allow	Criteria
F2:F18	List	='data validation'!$A$1:$A$4
K2:K18	List	='data validation'!$B$1:$B$3

 

[DanteAmor]

I did the test with your data and I have no error.
Run the following macro and type whatever appears in the message.

Sub create_worksheets()
  Dim c As Range, sh As Worksheet, ky As Variant
  
  Application.ScreenUpdating = False
  Set sh = Sheets("Overview")
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("K2", sh.Range("K" & Rows.Count).End(xlUp))
      If c.Value <> "" Then .Item(c.Value) = Empty
    Next c
    For Each ky In .Keys
      If Evaluate("ISREF('" & ky & "'!A1)") Then
        sh.Range("A1").AutoFilter Columns("K").Column, ky
        MsgBox "ky " & ky
        sh.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(ky).Range("A" & Rows.Count).End(3)(2)
        sh.AutoFilter.Range.Offset(1).EntireRow.Delete
      End If
    Next ky
  End With
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
End Sub

 

[chefpolo]

Still getting the error on this line of code

sh.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(ky).Range("A" & Rows.Count).End(3)(2)

 

[DanteAmor]

But before the error, a msgbox appears, tell me what the msgbox says.
---
Some data was copied or nothing?