KAZSTREBOR
New Member
- Joined
- Feb 18, 2021
- Messages
- 9
- Office Version
- 365
- Platform
- Windows
Hi there, I'm working on this macro to automatically fill data from one sheet to another. The issue I'm running into is that it is clearing out any data that is already there even if it isn't replacing anything. I'm not sure if this is even fixable but I appreciate it if you want to take a look. Thanks!
VBA Code:
Private Sub Blue_Autofiller()
'Defines sheets
Dim report_ws As Worksheet
Dim timesheet_ws As Worksheet
Dim error_ws As Worksheet
Set report_ws = Sheets("TransactionList")
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 from the report
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(4, 6), report_ws.Cells(report_ws.UsedRange.Rows.Count, 6))
Set caregiver_names_to_trim = report_ws.Range(report_ws.Cells(4, 5), report_ws.Cells(report_ws.UsedRange.Rows.Count, 5))
Set dates_to_trim = report_ws.Range(report_ws.Cells(4, 2), report_ws.Cells(report_ws.UsedRange.Rows.Count, 2))
Set decimal_column = report_ws.Range(report_ws.Cells(4, 4), report_ws.Cells(report_ws.UsedRange.Rows.Count, 4))
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(5, 15).Value = "=(D5)"
report_ws.Range(report_ws.Cells(5, 15), report_ws.Cells((report_ws.UsedRange.Rows.Count) - 2, 15)).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 3 rows are junk data that's not worth looking at
For visit_count = 5 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, 6), report_ws.Cells(visit_count, 6)).Value
caregiver_name = report_ws.Range(report_ws.Cells(visit_count, 5), report_ws.Cells(visit_count, 5)).Value
day_of_visit = report_ws.Range(report_ws.Cells(visit_count, 2), report_ws.Cells(visit_count, 2)).Value
hours_worked = report_ws.Range(report_ws.Cells(visit_count, 15), report_ws.Cells(visit_count, 15)).Value
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