VBA code pls. Open the P6-TrackingWorkbook.xlsm and write a VBA subroutine to co

Question

VBA code pls.

Open the P6-TrackingWorkbook.xlsm and write a VBA subroutine to copy (and merge) the data from the worksheets entitled Employer Data Part 1 and Employee Data Part I & II to a new (inserted) worksheet named "Merge-Ready" with the flattened data that is "mail merge" ready. Worksheet: Employer Data Part 1 Each row of the flattened data written to the "Merge-Ready" worksheet should contain the company data from the Employer Part 1worksheet cells B4: B10 - combined with the employee data located on the Employee Data Part I & II worksheet. For example, the first row of flattened data will copy data from cells A2: I2: J2: V2: J3: V3: and J4: V4;. Row 1 in the "Merge-Ready" worksheet must have column headings appropriate for the data it labels. Sample Solution for Worksheet Merge-Ready (too wide for one screen shot):

Explanation / Answer

Sub DisplayRecords()
Const RESULTS_COLUMN As Long = 5
Dim strEmployeeCode As String
Dim dtStartDate As Date, dtEndDate As Date
Dim c As Range
On Error GoTo ErrorTrap
strEmployeeCode = [EmployeeCode]
dtStartDate = [StartDate]
dtEndDate = [EndDate]
' Clear the results column
With Sheet1
.Columns(RESULTS_COLUMN).ClearContents
.Cells(1, RESULTS_COLUMN).Value = "Results"
.Cells(1, RESULTS_COLUMN).Font.Bold = True
End With
For Each c In Sheet1.UsedRange.Columns(1).Cells
If c.Value = strEmployeeCode And c.Offset(, 1) >= dtStartDate And c.Offset(, 1) <= dtEndDate Then
' Find the next available cell in results column
Sheet1.Cells(Sheet1.Rows.Count, RESULTS_COLUMN).End(xlUp).Offset(1).Value = c.Offset(, 1).Value
End If
Next c
Exit Sub
ErrorTrap:
MsgBox "An error has occurred, please check input criteria", vbExclamation, ThisWorkbook.Name
End Sub

Related Questions

Navigate

• Browse (All)
• Browse V
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.