Search one sheet Column Range, for rows that contain text, copy cell as well as 3 cells in same row to a table in Sheet 2

Question

Timesheets: Totals Report:

I'm attempting to write a macro which searches through a sheet named "Timesheet", Column C (Project), Rows 7-70, and for any cell that contains text, have it then copy the value of that cell, as well as the next three columns D-F (Task, Client, Project PO) of the same row, and paste these value into the table on the sheet known as "Totals Report". It then has to search through sheet "Timesheet", range H7:N7 and range H8:N8, and for any cell (day of the week) that contains text (hrs and comments), have it then copy the value of those cells to the table on sheet "Totals Report" In other words, would need to repeat this process and be copied as a new line item in the table on sheet "Totals Report" for each day of the week.

The code below is what I have right now, but it is incredibly inefficient:

Private Sub CommandButton1_Click()

Dim Project1a As String, Task1a As String, Client1a As String, Project_PO1a As String, Employee_Name As String, Employee_Number As String, Date_Mon1a As String, MonHrs1a As Integer, MonComm1a As String, Date_Tue1a As String, TueHrs1a As Integer, TueComm1a As String, Date_Wed1a As String, WedHrs1a As Integer, WedComm1a As String, Date_Thu1a As String, ThuHrs1a As Integer, ThuComm1a As String, Date_Fri1a As String, FriHrs1a As Integer, FriComm1a As String, Date_Sat1a As String, SatHrs1a As Integer, SatComm1a As String, Date_Sun1a As String, SunHrs1a As Integer, SunComm1a As String

Dim i As Integer, intCounter As Integer

Employee_Name = "Employee Name"
Employee_Number = "Employee Number"
Date_Mon1a = " Expense Date"
MonComm1a = "Comment"

i = 1
intCounter = 1

'Project 1, Week1 Mon-------------------
Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Mon1a = Range("H6")
MonHrs1a = Range("H7")
MonComm1a = Range("H8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(1, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Mon1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MonHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MonComm1a

'Project 1,Week1 Tues-------------------------

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Tue1a = Range("I6")
TueHrs1a = Range("I7")
TueComm1a = Range("I8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(2, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(2, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Tue1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TueHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TueComm1a

'Project 1,Week1 Wed

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Wed1a = Range("J6")
WedHrs1a = Range("J7")
WedComm1a = Range("J8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(3, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(3, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Wed1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = WedHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = WedComm1a

'Project 1,Week1 Thu

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Thu1a = Range("K6")
ThuHrs1a = Range("K7")
ThuComm1a = Range("K8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(4, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(4, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Thu1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ThuHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ThuComm1a

'Project 1,Week1 Fri

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Fri1a = Range("L6")
FriHrs1a = Range("L7")
FriComm1a = Range("L8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(5, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(5, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Fri1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FriHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FriComm1a

'Project 1,Week1 Sat

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Sat1a = Range("M6")
SatHrs1a = Range("M7")
SatComm1a = Range("M8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(6, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If

ActiveCell.Offset(6, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Sat1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = SatHrs1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = SatComm1a

'Project 1,Week1 Sat

Worksheets("Time").Select
Employee_Name = Range("D2")
Employee_Number = Range("D3")
Project1a = Range("C8")
Task1a = Range("D8")
Client1a = Range("E8")
Project_PO1a = Range("F8")
Date_Sun1a = Range("N6")
SunHrs1a = Range("N7")
SunComm1a = Range("N8")

Worksheets("Totals Report").Select
Worksheets("Totals Report").Range("A1").Select
If Worksheets("Totals Report").Range("A1").Offset(7, 0) <> "" Then
Worksheets("Totals Report").Range("A1").End(exlDown).Select
End If
ActiveCell.Offset(7, 0).Select
ActiveCell.Value = Project1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Task1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Client1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Project_PO1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Employee_Number
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date_Sun1a
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = SunHrs1a
ActiveCell.Offset(0, 1).Select

ActiveCell.Value = SunComm1a

End Sub

A couple of other attempts included...

Private Sub CommandButton1_Click()
Dim i As Integer
Dim intCounter As Integer
Dim Project As String
Dim Task As String
Dim Client As String
Dim ProjectPO As String
Dim Hours As Integer
Dim Com As String

Adjust intCounter if you want to start on a row other than 1
intCounter = 8

Do
    With Worksheets("Time")
        Project = .Cells(intCounter, 3).Value
        Task = .Cells(intCounter, 4).Value
        Client = .Cells(intCounter, 5).Value
        ProjectPO = .Cells(intCounter, 6).Value
    End With

    i = 1
    Do While i < 3



        If Worksheets("Shift").Range("a3").Value <> "" Then
           Worksheets("Shift").Range("a2").End(xlDown).Select
        End If



        With Worksheets("Totals Report")
            .Cells(i + 1, 1).Value = Project
            .Cells(i + 1, 2).Value = Task
            .Cells(i + 1, 3).Value = Client
            .Cells(i + 1, 4).Value = ProjectPO
        End With

        i = i + 1
    Loop


    intCounter = intCounter + 2
Loop
End Sub

and....

Private Sub CommandButton1_Click()
Dim Project As Range, c As String
Project = Range("C7:C10")




Dim Project1Wk1 As Range, SrchRng As Range, c As Range

SrchRng = Range("C7:C70")
Project1Wk1 = Range("C8:F8")

For Each c In Sheets("Time").Range("SrchRng")
If c.Value <> "" Then
    For i = 1 To 3
        Cells(1, i).Value = i
    Selection.Copy
        Sheets("Totals Report").Select
            If Sheets("Totals Report").Range("A1").Offset(1, 0) <> "" Then
        Sheets("Totals Report").Range("A1").End(exlDown).Select
End If

Next c
End Sub

Is there something I can do to optimize my code to run better?

Is there any specific problem? E.g. something that doesn't work or behave as expected? Please highlight that problem than, so we have something specific to answer. As far as the inefficiency bit goes: Read [How to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) - That should already help a lot. — Rik Sportel, Jul 04 '17 at 05:13
The problem is that I do not know how to effectively apply the VBA For Loops.Please see my attached photos of sheets Timesheet & Totals Report. The sheet "Timesheet" would be filled out by employee named Joe, who would select from cell C8, the Project and associated task that he worked on that week. — LSmith000, Jul 04 '17 at 06:10
He would also enter data for each day of the week including the total hours (so for project 1, hours totals for Mon- Sun would be entered into cells H7:N7 and comments regarding those hours worked on Project 1 would be entered into cells H8:N8). A command named "Submit" could then be selected and all the cell values for project 1 would be copied and pasted into the table on sheet "Totals Report" for each day of the week. In other words if all cells had values for Project 1, there would be 7 line items in the table on sheet Totals Report. — LSmith000, Jul 04 '17 at 06:10

Search one sheet Column Range, for rows that contain text, copy cell as well as 3 cells in same row to a table in Sheet 2

0 Answers0