KAZSTREBOR
New Member
- Joined
- Feb 18, 2021
- Messages
- 9
- Office Version
- 365
- Platform
- Windows
Hello there! I am inheriting this code and have been voluntold into updating it. Currently as it inputs data from the report it deletes all of the current cells in the worksheet. Instead I am wondering if it is possible to overwrite cell contents only if there is new data to be added. Any help is much appreciated, thanks!
VBA Code:
Sub Timesheet_Autofiller()
'Defines sheets, may need tweaking for different pay periods/arrangements, come up with universal system
Dim report_ws As Worksheet
Dim timesheet_ws As Worksheet
Dim error_ws As Worksheet
Set report_ws = Sheets("Report")
ActiveWorkbook.Sheets.Add
Set error_ws = ActiveSheet
Dim current_sheet As String
current_sheet = InputBox("Enter the exact name of the current timesheet you're using.")
Set timesheet_ws = Sheets(current_sheet)
Dim sunday_column As Integer
Dim found_sunday_column As Boolean
sunday_column = 0
found_sunday_column = False
Do While found_sunday_column = False
sunday_column = sunday_column + 1
If timesheet_ws.Cells(2, sunday_column).Value = "S" Then
If timesheet_ws.Cells(2, sunday_column).Interior.Color = RGB(255, 255, 153) Then
found_sunday_column = True
End If
End If
Loop
'This section is to clean up the messy formatting spit out by HHA
Dim patient_names_to_trim As Range
Dim caregiver_names_to_trim As Range
Dim dates_to_trim As Range
Dim decimal_column As Range
Dim oCell As Range
Dim Func As WorksheetFunction
Dim timesheet_lastrow As Integer
Dim lastrow_counter As Integer
lastrow_counter = 5
Dim lastrow_counter_done As Boolean
lastrow_counter_done = False
Do While lastrow_counter_done = False
If IsEmpty(timesheet_ws.Cells(lastrow_counter, 1).Value) = False Then
lastrow_counter = lastrow_counter + 1
End If
If IsEmpty(timesheet_ws.Cells(lastrow_counter, 1).Value) = True Then
timesheet_lastrow = lastrow_counter
lastrow_counter_done = True
End If
Loop
timesheet_ws.Range(timesheet_ws.Cells(5, sunday_column), timesheet_ws.Cells(timesheet_lastrow, sunday_column + 13)).ClearContents
Set patient_names_to_trim = report_ws.Range(report_ws.Cells(36, 25), report_ws.Cells(report_ws.UsedRange.Rows.Count, 25))
Set caregiver_names_to_trim = report_ws.Range(report_ws.Cells(36, 13), report_ws.Cells(report_ws.UsedRange.Rows.Count, 12))
Set dates_to_trim = report_ws.Range(report_ws.Cells(36, 34), report_ws.Cells(report_ws.UsedRange.Rows.Count, 34))
Set decimal_column = report_ws.Range(report_ws.Cells(36, 68), report_ws.Cells(report_ws.UsedRange.Rows.Count, 65))
Set Func = Application.WorksheetFunction
Set ts_names_to_trim = timesheet_ws.Range(timesheet_ws.Cells(5, 4), timesheet_ws.Cells(lastrow_counter, 7))
For Each oCell In patient_names_to_trim
oCell = Func.Trim(oCell)
Next
For Each oCell In caregiver_names_to_trim
oCell = Func.Trim(oCell)
Next
For Each oCell In dates_to_trim
oCell = Func.Trim(oCell)
Next
For Each oCell In ts_names_to_trim
oCell = Func.Trim(oCell)
Next
report_ws.Cells(36, 68).Value = "=hour(AX36)+minute(AX36)/60"
report_ws.Range(report_ws.Cells(36, 68), report_ws.Cells((report_ws.UsedRange.Rows.Count) - 2, 68)).FillDown
'End clean up section
'This is the main meat of the section that compares entries, finds matches for days, and inputs time automatically, removing need to manually type thousands of numbers from paper printouts
Dim visit_count As Integer
Dim error_count As Integer
error_count = 1
'The first 33 rows are junk data that's not worth looking at
For visit_count = 36 To (report_ws.UsedRange.Rows.Count - 2)
Dim consumer_count As Integer
Dim found_match As Boolean
found_match = False
For consumer_count = 5 To timesheet_lastrow
'Scrapes data from the report
Dim patient_name As String
Dim caregiver_name As String
Dim day_of_visit As String
Dim hours_worked As Double
patient_name = report_ws.Range(report_ws.Cells(visit_count, 25), report_ws.Cells(visit_count, 25)).Value
caregiver_name = report_ws.Range(report_ws.Cells(visit_count, 13), report_ws.Cells(visit_count, 13)).Value
day_of_visit = report_ws.Range(report_ws.Cells(visit_count, 34), report_ws.Cells(visit_count, 34)).Value
hours_worked = report_ws.Range(report_ws.Cells(visit_count, 68), report_ws.Cells(visit_count, 68)).Value
'MsgBox patient_name & " " & caregiver_name & " " & day_of_visit & " " & hours_worked
Dim ts_patient_name As String
Dim ts_caregiver_name As String
Dim ts_day_of_visit As String
Dim ts_hours_worked As Double
ts_patient_name = timesheet_ws.Range(timesheet_ws.Cells(consumer_count, 4), timesheet_ws.Cells(consumer_count, 4)).Value
ts_caregiver_name = timesheet_ws.Range(timesheet_ws.Cells(consumer_count, 7), timesheet_ws.Cells(consumer_count, 7)).Value
If patient_name = ts_patient_name Then
If caregiver_name = ts_caregiver_name Then
Dim current_day As Integer
For current_day = sunday_column To (sunday_column + 13)
If day_of_visit = timesheet_ws.Cells(3, current_day).Value Then
If IsEmpty(timesheet_ws.Cells(consumer_count, current_day).Value) = False Then
timesheet_ws.Cells(consumer_count, current_day).Value = timesheet_ws.Cells(consumer_count, current_day).Value + Round(hours_worked, 2)
End If
If IsEmpty(timesheet_ws.Cells(consumer_count, current_day).Value) = True Then
timesheet_ws.Cells(consumer_count, current_day).Value = Round(hours_worked, 2)
End If
found_match = True
End If
Next current_day
End If
End If
Next consumer_count
If found_match = False Then
error_ws.Cells(error_count, 1).Value = patient_name
error_ws.Cells(error_count, 2).Value = caregiver_name
error_ws.Cells(error_count, 3).Value = day_of_visit
error_ws.Cells(error_count, 4).Value = hours_worked
error_count = error_count + 1
End If
Next visit_count
End Sub
