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:banghead: Dots:banghead: Dots:banghead: Dots:banghead: Dots:banghead: Dots:banghead: Dots:banghead:

[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)

[SamT]

By all means, jump in.

Thanks for that Test bed. You put some time into it. It is a really good learning tool.

I don't understand why this didn't work. X shows the correct Row number, even though the next line fails. Caution: may be typos
Sub PossiblyMoreEfficient_By_SamT()
Dim r As Long
Dim X
With Sheets("Sheet2")
For r = .Cells(Rows.Count, "A").End(xlUp).Row 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
X = Sheets(Cells(r, 4).Text).Cells(Rows.Count, "A").End(xlUp).Row + 1
'Fails: .Cells(r, 3).Resize(1, 5).Copy Sheets(Cells(r, 4).Text).Range("A" & Cells(Rows.Count, "A").End(xlUp).Row +1) 'Fails
'Works: .Cells(r, 3).Resize(1, 5).Copy Sheets(Cells(r, 4).Text).Range("A" & X) 'Works .Cells(r, 3).EntireRow.Delete
End If
End If
Next r
End With
End Sub

Using Range.Offset instead of Range.Address works
Sub PossiblyMoreEfficient_By_SamT()
Dim r As Long
Dim X

With Sheets("Sheet2")
For r = .Cells(Rows.Count, "A").End(xlUp).Row 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).Resize(1, 5).Copy Sheets(Trim(Cells(r, 4).Text)).Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Cells(r, 3).EntireRow.Delete
End If
End If
Next r
End With
End Sub

[oam]

Jolivanes and SamT,

Thank you both for your hard work on this project it got a little more complicated than I anticipated.

Attached is a sanitized version of the file.

[oam]

SamT,

I just tried your second code from Post 21 and it worked good. It moved the row of data to the correct worksheet and the next entry was added on and NOT over written. More test to complete but I think you got it!

Thank you so very much for your help. If all the testing works I will mark the post "Solved".
Again, thank you!

[oam]

SamT,

The code work great. I tried it on multiple row and different worksheet and the code does what I need it to, Thank you and Jolivanes so much for all your help on getting this working, it will save the user a lot of work.

Just one question, you Dim X on both codes, I do not see it used anywhere in the code, what is it used for?

[SamT]

I used it for troubleshooting, a standard practice. I left it in the first code, where it is used, to show the problem and a possible solution.

I forgot to remove it from the second code, it is merely superfluous and does no good nor harm.

[oam]

Thank you for all your help, the code work perfectly.