Copy data between sheets

[had1015]

Hi,

I posted this question at the following location and have not gotten response:
https://www.excelforum.com/excel-programming-vba-macros/1293258-copy-employee-data-between-sheets.html

I have several hundred project task sheets (indicated as sheet names like the attached “1000 A 1” in the attached workbook) that I’m looping through in my workbook that takes many hours of manual input. I would like to a macro to transfer employee information from the “MR” worksheet to the project Task worksheets. I’ve included a sample workbook to clarify my problem. I am trying to transfer hours worked in weekly increments based on the end period date which are located on row 21 on each project task sheet. On the project sheet I set up weekly columns to transfer employee information (ID, Last Name, First and Middle Initials and hours worked) for each project.

1. Cell “C4” on each project task sheet is the same as the sheet name which is also the project number.
2. I need to find that same project number located in on the PR sheet column A.
3. When it's identified, I need to match that project number in the PR sheet column A to the MR sheet column A, the end period PR sheet column K to the MR sheet column B and LC code PR sheet column P to the MR sheet column E.
4. Whenever those three matches are made I need to copy the matched column A adjacent cell values (Employee Number, LC Code, Employee Name and Initials) from the MR sheet columns D, E, F, and G to the project task sheet starting with cell A25 through D25.
5. Then copy the hours worked from the adjacent cell column H to the task sheet appropriate adjacent cell for that respective end period date. Any additional hours worked for this same project by another employee will be transferred directly beneath the first employee information and hours.

You can see the before and after project task sheets in the attached file.
Any assistance you provide is greatly appreciated.

I've tried to use some code below but it's not working for me:



Sub CopyEmployeeData()
Dim Firstrow As Long
Dim Lastrow As Long
Dim PRLastrow As Long
Dim MRLastrow As Long
Dim Lrow As Long
Dim PRLrow As Long
Dim MRLrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 2
Lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
PRLastrow = Sheets("PR").Cells(.Rows.Count, "A").End(xlUp).Row
MRLastrow = Sheets("MR").Cells(.Rows.Count, "A").End(xlUp).Row
For Lrow = Lastrow To Firstrow Step -1
For PRLrow = PRLastrow To Firstrow Step -1
For MRLrow = MRLastrow To Firstrow Step -1
With .Cells(Lrow, "C")
If Not IsError(.Value) Then
If .Value = Sheets("PR").Cells(Lrow, "A").Value Then
If Sheets("PR").Cells(PRLrow, "A").Value = Sheets("MR").Cells(MRLrow, "A").Value And _
Sheets("PR").Cells(PRLrow, "K").Value = Sheets("MR").Cells(MRLrow, "B").Value And _
Sheets("PR").Cells(PRLrow, "P").Value = Sheets("MR").Cells(MRLrow, "E").Value Then
.Offset(18, -2).Value = Sheets("MR").Cells(MRLrow, "A").Value
End If
End If
End If
End With
Next MRLrow
Next PRLrow
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

[SamT]

It ain't that hard, but it will mess up next week when the same employee info gets copied below this week's info.

Why aren't MR and PR sorted by Project and LC?

[had1015]

Thank you for responding SamT. No particular reason they can be sorted without any problems whatsoever, I probably should have sorted them though.

[had1015]

SanT, however, when I try sorting LC I need to maintain the leading zero structure so numbers stored as text does not sort as I expected.

[had1015]

Would it be possible to have the same employee id, name, and lc remain unchanged or not added again in columns a thru d except when there is a change in lc in column b during upcoming weeks?

[had1015]

Sorry SamT I unintentionally typed SanT. I mean no disrespect. I really appreciate your help.

[SamT]

About how many rows will Mr and PR be each?

How often do you have to perform this task?

[had1015]

MR will be between 700 and 800 rows. PR will be about 90,000 rows. I have to perform this once per week.

[SamT]

this code goes in Module "Setup_Utilities". I wrote it to standardize the Date labels in the Project sheets
Option Explicit
Option Private Module 'Will not show these subs in the Excel Macro menu

Private Sub FormatDateRows()
Dim Sht As Worksheet
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "MR" Or Sht.Name = "PR" Then GoTo NextSht
With Sht
.Rows(5).NumberFormat = "*MMM-yyyy"
.Rows(7).NumberFormat = "*mm/dd/yy"
.Rows(21).NumberFormat = "*mm/dd/yy"
End With
NextSht:
Next Sht
End Sub


This is as far as I have gotten in the module "MainModule". I am now working on Sub Main and it's attendant sub procedures

Option Explicit
Const mrProjectCol As Long = 1
Const mrEndPeriodCol As Long = 2
Const mrLCcol As Long = 3
Const empPmpNum As Long = 1
Const empLastCol As Long = 2
Const empFirstCol As Long = 3
Const empHoursCol As Long = 4
Const empRateCol As Long = 5
Const prProjectCol As Long = 1
Const prEndPeriodCol As Long = 2
Const prLCcol As Long = 3
'These Arrays use the above declared Constants
Dim MR_Array As Variant
Dim Emp_Array As Variant
Dim PR_Array As Variant
Dim TempSht As Worksheet

Private Sub MoveColumns()
'Copies all relevant data to Tempsht in memory
'Do in memory
'Because Sheet PR Changes every week
' Not related to Constants declared above
Dim PR_ProjectColumn As Long
Dim PR_LCColumn As Long
Dim PR_EndPeriodColumn As Long
With Sheets("PR").Rows(1)
PR_ProjectColumn = .Find("Project").Column
PR_LCColumn = .Find("LC").Column
PR_EndPeriodColumn = .Find("End Period").Column
End With
With TempSht
Sheets("MR").Range("A:B,E:E").Copy .Columns("A:A") 'Project, EndPeriod, and LC
Sheets("MR").Columns("D:I").Copy .Columns("E:E") 'Emp #, Last, First, HOURS, and RATE
Sheets("PR").Columns(PR_ProjectColumn).Copy .Range("K1")
Sheets("PR").Columns(PR_EndPeriodColumn).Copy .Range("L1")
Sheets("PR").Columns(PR_LCColumn).Copy .Range("M1")
End With
Application.CutCopyMode = False
End Sub

Sub t()
'Test stub
MoveColumns
End Sub

Private Sub MakeArrays()
With Sheets("Temp")
MR_Array = .Range("A1").CurrentRegion
Emp_Array = .Range("D1").CurrentRegion
PR_Array = .Range("J1").CurrentRegion
End With
'Now, we are done with sheet temp. Clear the memory
Set TempSht = Nothing
End Sub

Private Sub Main()
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation 'Store it for later
ViewMode = ActiveWindow.View
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' To be written
'
'
With Application
.Calculation = CalcMode
ActiveWindow.View = ViewMode
.ScreenUpdating = TrueEnd With

End Sub

[had1015]

SamT I thank you so much for your time, expertise and consideration in developing this code. I’m blown away by what you’re doing and how you so graciously are helping me.

[had1015]

SamT I’ve been viewing what you have so far. Thank you for helping me with this. Just wanted to mention that sheet PR have additional columns of data that I did not initially think would impact. I have 80 used columns on that sheet.

[had1015]

SamT thanks for helping me with this, just wanted to mention that PR sheet has a total of 80 used columns. I initially did not think that it would have an impact but reviewing your code I’m not so sure anymore.

[SamT]

I noticed. It is good that you are reviewing the code, since you are the one who will have to maintain it. I hope I a, writing it so that it is self documenting.

I am currently pondering the necessary tests, error checks and edge conditions this code might run into in production.

This is the list of Module level Declarations I have so far. I present it for your review and error checking

Option Explicit
Option Base 1

'All these Declarations are used throughout the code
' They are declared here for ease of code maintainence.
' IOW, you don't have to search the code to change them.

'Array Constants
Const mrProjectCol As Long = 1
Const mrEndPeriodCol As Long = 2
Const mrLCcol As Long = 3

Const empPmpNum As Long = 1
Const empLastNameCol As Long = 2
Const empFirstNameCol As Long = 3
Const empHoursCol As Long = 4
Const empRateCol As Long = 5

Const prProjectCol As Long = 1
Const prEndPeriodCol As Long = 2
Const prLCcol As Long = 3

'Project sheet Descriptors
' Many of these are not used at this time
' They are included here for future use
Const psWeeklyDateRow As Long = 21
Const psEmpDataHeaderRow As Long = 21
Const psEmpNumCol As Long = 1
Const psEmpLCCol As Long = 2
Const psEmpLastNameCol As Long = 3
Const psEmpFirstNameCol As Long = 4
Const psEmpEXPCol As Long = 10
' Const psEmpBALCol As Long = 5
' Const psEmpAUTHCol As Long = 6
' Const psEmpEXP2Col As Long = 7 'there are two EXP columns on each Project Sheet
' Const psEmpESTCol As Long = 8
' Const psEmpRATECol As Long = 9

Dim psEmpRow As Long
Dim DataDateCol As Long


'These Arrays use the above declared Array Constants
Dim MR_Array As Variant
Dim Emp_Array As Variant
Dim PR_Array As Variant
Dim mrIndex As Long
'EmpArray uses mrIndex
Dim prIndex As Long

'A Temporary array used to check the spelling of the names in MR and PR
Dim ProjectNames() As String

'Used to temporarily hold data so it can be added to various Arrays
Dim TempSht As Worksheet

[had1015]

SamT, I've reviewed your last list of declarations and they all seem ok to me, however, for:



Dim psEmpRow As Long
Dim DataDateCol As Long


should it be:



Dim psEmpRow As Long
Dim mrDataDateCol As Long


Also, where is psEmpRow located in ps sheet?

Thanks again for your help.

[SamT]

DataDateCol could/should be psDataDateCol

psEmpRow will be assigned during execution and will be either a matching employee's Row or the next empty employee slot. Ie, the row the necessary data will be stored in.

psDataDateCol will be the column in the project sheet that the relevant date is in, ie, the column that hours will be stored in.

Both of those will change from week to week and from employee to employee.

[SamT]

David, I have been thinking about speed of execution. I note that your numbers are about 200 Project sheets, 1K Rows (MR), and 100K Rows (PR)

I strongly suspect that PR is some kind of historical Data. Shouldn't you delete any Rows in PR that do NOT reference an actual Project Sheet? Especially since one of the required checks of the code I'm writing will check for that actuality on the basis of checking the spelling of the Project ID#?

Note that it also checks the Project IDs in MR against actual Project sheets, but I suspect that the MR data is generated each week and only references actual Projects.

Secondary question: Should the PR Row deletion code check for data dates 1 and 2 or just for the existence of an actual Project sheet?

[had1015]

Thanks SamT the check is for the existence of the project sheet. Maybe filter out some of the PR data as you suggested. Possibly filter only the Project sheets where MR shows employee hours exist.

[SamT]

I don't know what you mean by "filter out." I am talking about deleting rows in the PR sheet that don't reference an existing Project sheet.

The length of the MR data is insignificant, only ~1000 rows, that will take only milliseconds to loop thru. However, you will be looping at least part way thru the PR data once for every line in the MR data.

If there is no match in PR for any given line(s) in MR, the code must loop all the way thru the PR data. That will take significant time; perhaps seconds each. I can't do anything from here about the time it will take to search and write to each Project sheet, but it would be nice to eliminate as many bottlenecks as possible.

While I wish I could get the code to complete your weekly task in less than 10 seconds, I am hoping that it will take less than 3 minutes. At this point, I am guessing that it will finish ~50 to ~100 project sheets per minute + the time it takes to loop thru PR for each line in MR.


where MR shows employee hours existThank you for that tidbit. Got any more?

[SamT]

Ticket closed due to lack of response