Update cells

[esskaykay]

I’m not sure what type a problem this is (lookup table, progressive IF statement, VBA, or other issue) but I thought I’d start here. If this should be posted elsewhere, please let me know.

We have an Excel spreadsheet that tracks our timecard activities. We’re in the process of moving all payroll items to our new system financial software which means all tracking will be done inside the new app not Excel. However, the spreadsheet works so much easier. What I want is to update an Access table from Excel. This gets a bit confusing but I’ll try to explain my problem.

I’d like to update a cell in one worksheet (DATABASE) based on info from another worksheet (TIMECARD). I have a routine from a kind sole here, that creates a list of rows in DATABASE based on dates entered TIMECARD. Now I need to add a couple additional cells for the PROGRAM and ACTIVITY data. If an entry is made for a date in TIMECARD, then I’d like the PROGRAM and ACTIVITY cells in DATABASE to include that entry for the line corresponding to that specific date.

I have attached an extremely slimmed down version of my spreadsheet showing what I have in mind.

In the old Lotus 1-2-3 days, I could have solved this with “keystroke macros”, but now with VBA, I’m totally lost. Any suggestions would be greatly appreciated.

Thanks,
Steve Kipping

[StephenR]

Steve: here is a slightly different approach, all of which assumes as in your original that the data in the first sheet is always the same size. Btw you have a lot of empty modules which you could remove to tidy things up.

Sub CopyData()
   
Dim r As Long, rng As Range

With Sheets("Database")
    .UsedRange.ClearContents
    .Range("A1:C1") = [{"DATE","PROGRAM","ACTIVITY"}]
    For Each rng In Sheets("Timecard").Range("K8:Q8")
        For r = 1 To 6
            If Not IsEmpty(rng.Offset(r)) Then
                .Cells(Rows.Count, 1).End(xlUp)(2) = rng
                .Cells(Rows.Count, 2).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "H")
                .Cells(Rows.Count, 3).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "I")
            End If
        Next r
    Next rng
End With

End Sub

[esskaykay]

This is superb Stephen...

I'll have to play with this a bit as my full spreadsheet has numerous other cells etc. to update but hopefully I can wade through this. Once I get it all working, I'll go back and cleanup the bogus modules.

I may need some assistance in the future. I hope you don't mind me possibly imposing on you (and others) a bit more in the future.

Thanks again,
SKK

[esskaykay]

Stephen,

I have modified your code a bit to match the entire spreadsheet. However, I’m still missing a couple things.

1. I’d like to add the EMPLOYEE number to each record. This is always the same number for each. It is stored in the TIMECARD worksheet in cell N3.
2. Here’s the tougher one. I forgot about the most important item. We need the hours worked for each activity. I add the HOURS column but have no idea where to go from here.

Here’s my modified code:



Again, any suggestions would be greatly appreciated.

Thanks,
SKK

[StephenR]

Try this. Also added a little formatting at the end.

Sub CopyData()

Dim r As Long, rng As Range

With Sheets("Database")
    .UsedRange.ClearContents
    .Range("A1:K1") = [{"EMPLOYEE","DATE","PROGRAM","ACTIVITY","EARN CODE","SHIFT","SPECIAL RATE","FUND","ORG","ACCOUNT","HOURS"}]
    For Each rng In Sheets("Timecard").Range("K8:Q8")
        For r = 1 To 39
            If Not IsEmpty(rng.Offset(r)) Then
                .Cells(Rows.Count, 1).End(xlUp)(2) = Sheets("Timecard").Cells(3, "N")
                .Cells(Rows.Count, 2).End(xlUp)(2) = rng
                .Cells(Rows.Count, 3).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "H")
                .Cells(Rows.Count, 4).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "I")
                .Cells(Rows.Count, 5).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "A")
                .Cells(Rows.Count, 6).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "B")
                .Cells(Rows.Count, 7).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "D")
                .Cells(Rows.Count, 8).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "E")
                .Cells(Rows.Count, 9).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "F")
                .Cells(Rows.Count, 10).End(xlUp)(2) = Sheets("Timecard").Cells(r + 8, "G")
                .Cells(Rows.Count, 11).End(xlUp)(2) = rng.Offset(r)
                With .UsedRange
                    .Columns(2).NumberFormat = "m/d/yyyy"
                    .HorizontalAlignment = xlCenter
                    .Columns.AutoFit
                End With
            End If
        Next r
    Next rng
End With
End Sub

[esskaykay]

Stephen,

I hate to keep bugging you but one more question. If PROGRAM or ACTIVITY cells are blank in the TIMECARD worksheet, it returns incorrect data in the DATABASE worksheet.

I have attached a full blown copy of our spreadsheet. If you could take one more look at this, I think we (or should I say you) are very close to what I need.

Thanks again,
SKK