Moving entire row of data based on two cell values

[oam]

I have workbook containing several worksheets (GEPS, RO, or DC) one for each area within the facility where each employee is assigned to work and each row of the worksheet contains employees’ name and other personal information.
When new employees are first hired they are listed in the Employee Pool worksheet (as much as 100 rows) and after they have completed the training program the employees are assigned to work area (GEPS, RO, or DC, etc...).

I need a macro that will move an entire row of employee data from Employee Pool worksheet (see sample below) to the worksheet listed in the Work Assignment dropdown in column D when Training Code (Column C) 2 or 3 is selected and Work Assignment (Column D) is either GEPS, RO, or DC is selected. In addition, the row on the Employee Pool worksheet where the employee was previously listed needs to be deleted.

Can anyone help me with this?

Thank you for any and all help

C	D	E	F	G
Training Code	Work Assignment	Work Status	Daily Hours	Employee Name
4	GP	BPA1		Jones, Bill

[jolivanes]

Like this?

Sub Maybe()
    Dim ws1 As Worksheet, lr As Long, j As Long
    Set ws1 = Sheets("Sheet2")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row    '<--- Assumes Column A is part of the data
    For j = lr To 2 Step -1
        If ws1.Cells(j, 3).Value = 2 And ws1.Cells(j, 4).Value = "GEPS" Or ws1.Cells(j, 4).Value = "RO" Or ws1.Cells(j, 4).Value = "DC" _
           Or ws1.Cells(j, 3).Value = 3 And ws1.Cells(j, 4).Value = "GEPS" Or ws1.Cells(j, 4).Value = "RO" Or ws1.Cells(j, 4).Value = "DC" Then
            ws1.Cells(j, 3).EntireRow.Copy Sheets(Cells(j, 4).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next j
End Sub

[SamT]

Jolivanes, Good code.

Here is the same code in a different Style

Option Explicit

Sub PossiblyMoreEfficient()
    
  Const C As Long = 1 '<--- Assumes Column A is part of the data. Edit as needed
  Dim LR As Long
  Dim r As Long
  
    With Sheets("Sheet2")
    LR = .Cells(Rows.Count, C).End(xlUp).Row
    For r = LR To 2 Step -1
        If .Cells(r, 3).Value = 2 Or .Cells(r, 3).Value = 3 Then
          If .Cells(r, 4).Value = "GEPS" Or .Cells(r, 4).Value = "RO" Or .Cells(r, 4).Value = "DC" Then
            .Cells(r, 3).EntireRow.Copy Sheets(Cells(r, 4).Value).Range("A" & .Cells(Rows.Count, C).End(xlUp).Row + 1)
          .Cells(r, 3).EntireRow.Delete
          End If
        End If
    Next r
End Sub

[jolivanes]

@SamT
Very kind of you. Thank you very much.
Here is another one to play with.

Sub jolivanes_Array()
    Dim arrExc, lr As Long, i As Long, j As Long, ws1 As Worksheet
    arrExc = Array("2GEPS", "3GEPS", "2RO", "3RO", "2DC", "3DC")
    Set ws1 = Sheets("Sheet2")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
        For j = LBound(arrExc) To UBound(arrExc)
            If CStr(Cells(i, 3).Value) + Cells(i, 4).Value = arrExc(j) Then
                ws1.Cells(i, 3).EntireRow.Copy Sheets(Cells(i, 4).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
        Next j
    Next i
End Sub

[jolivanes]

I forgot to delete the Rows in question. Thanks again SamT
Change that part of the first code (Post #2) to:

        If ws1.Cells(j, 3).Value = 2 And ws1.Cells(j, 4).Value = "GEPS" Or ws1.Cells(j, 4).Value = "RO" Or ws1.Cells(j, 4).Value = "DC" _
           Or ws1.Cells(j, 3).Value = 3 And ws1.Cells(j, 4).Value = "GEPS" Or ws1.Cells(j, 4).Value = "RO" Or ws1.Cells(j, 4).Value = "DC" Then
            ws1.Cells(j, 3).EntireRow.Copy Sheets(Cells(j, 4).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ws1.Cells(j, 3).EntireRow.Delete
        End If

and that part of the second code (Post #4) to:

        For j = LBound(arrExc) To UBound(arrExc)
            If CStr(Cells(i, 3).Value) + Cells(i, 4).Value = arrExc(j) Then
                ws1.Cells(i, 3).EntireRow.Copy Sheets(Cells(i, 4).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
                ws1.Cells(i, 3).EntireRow.Delete
            End If
        Next j

[SamT]

Arrays = really fast, but you forgot the Exit For.

















Not like I ever do that.

[jolivanes]

Is an "Exit For" required here?
Even if it would not be needed, should one include it for good practice?
And if so, where would it be?

[SamT]

Right after the Row.Delete

It is good practice. Why finish the inner loop if it has already tested True. On this small scale, no one will notice or begrudge the extra time, But if you always exit a loop as soon as it's work is done, you won't forget when the scale is large enough to be noticeable.

[jolivanes]

@SamT
Ok, I was not aware of that. And it makes sense now that you explain it.
Thanks for the explanation.
Appreciated.

Regards
John

[oam]

SamT,

I have tried your code and it almost does what I need it to do, it pastes the line of data on the correct worksheet but it is pasting the line on row 14 of a blank worksheet. Line 14 is the last line of data in my source worksheet before I run the code. You by far are the expert but I think it is looking at the "Cells(Rows.Count, 1).End(xlUp).Offset(1)" on the source worksheet as opposed to the destination worksheet.

Jolivanes,

I am working on making your code work.

Thank you both for all your help.

[SamT]

Put a dot before the word "Cells"
Sheets(.Cells(r, 4).Value)

[jolivanes]

As well as here maybe for good measurement
LR = .Cells(.Rows.Count, "C").End(xlUp).Row

[SamT]

LR = .Cells(Rows.Count, C).End(xlUp).Row
In the above Procedure, C is a Constant. Stands for the C_olumn that always has values all the way to the end of the table.
"C" will always use Columns(3)

Rows.Count is an Application and a Worksheet Property. It is invariant across the workbook. "Range.Rows.Count" is a Range property and must use the dot

With Range ("A1:D5")
X = .Rows.count

[oam]

SamT,

The data is still pasting to row 14 on the correct worksheet and subsequent rows of data from the source worksheet are added underneath the previous row of data. I added the dot as instructed (code below) but the results are the same. In addition, I showed the users, when working correctly, how the worksheet will work and they requested the data be pasted into column A and not leave the two columns vacant. Column A and B on the source worksheet are used for tracking progress of new employees and will not be needed when assigned to a permanent position so the information in column A and B does not need to be transfer to the assignment worksheet, is this possible?

Thank you for a quick response, this forum is the best!

Option Explicit 
 
Sub PossiblyMoreEfficient() 
    
    Const C As Long = 3 '<--- Assumes Column A is part of the data. Edit as needed
    Dim LR As Long 
    Dim r As Long 
    
    With Sheets("Employee Pool") 
        LR = .Cells(Rows.Count, C).End(xlUp).Row 
        For r = LR To 2 Step -1 
            If .Cells(r, 3).Value = 2 Or .Cells(r, 3).Value = 3 Then 
                If .Cells(r, 4).Value = "GEPS" Or .Cells(r, 4).Value = "RO" Or .Cells(r, 4).Value = "DC" Then 
                    .Cells(r, 3).EntireRow.Copy Sheets(.Cells(r, 4).Value).Range("A" & .Cells(Rows.Count, C).End(xlUp).Row + 1) 
                    .Cells(r, 3).EntireRow.Delete 
                End If 
            End If 
        Next r 
    End Sub

[oam]

Jolivanes,

Your code puts the data on the correct worksheet but it does not offset the rows. The next row of data that is moved over writes the previous row.

Thanks for your help

[SamT]

The data is still pasting to row 14 on the correct worksheet

"Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)" had a dot in front of "Cells". That referred the Rows Count back to the Source sheet

I showed the users, when working correctly, how the worksheet will work and they requested the data be pasted into column A and not leave the two columns vacant.

How did those two columns get vacant. The code definitely pastes into Column A.

Column A and B on the source worksheet are used for tracking progress of new employees and will not be needed when assigned to a permanent position so the information in column A and B does not need to be transfer to the assignment worksheet, is this possible?

So you only want 5 Columns, C to G, pasted in to Columns A to E? See ".Resize(1, 5)" In code. for more or less than five Columns copied, change the "5".

Sub ShouldWorkNow() 
 
    Dim r As Long 
     
    With Sheets("Employee Pool") 
        For r = .Cells(Rows.Count, C).End(xlUp).Row  To 2 Step -1 
            If .Cells(r, "C").Value = 2 Or .Cells(r, "C").Value = 3 Then 
                If .Cells(r, 4).Value = "GEPS" Or .Cells(r, 4).Value = "RO" Or .Cells(r, 4).Value = "DC" Then 
                    .Cells(r, "C").Resize(1, 5).Copy Sheets(.Cells(r, 4).Value).Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1) 
                    .Cells(r, "C").EntireRow.Delete 
                End If 
            End If 
        Next r 
    End Sub

Dots Dots Dots Dots Dots Dots Dots

[oam]

SamT,

The code puts the data on the correct row but now it does not offset, the next row of data to be copied over writes the previous row of data.

Thanks for your help

[SamT]

Upload a result sheet please.

[jolivanes]

@SamT
Re Post #13
I should quit while I am ahead. Or is it too late?
You're never too old to learn fits like a glove here.
Thanks again for the lesson.

[jolivanes]

Re: it does not offset
It does here.
This is what I am playing with (see attached)