Complicated Macro Issue

KAZSTREBOR

New Member
Joined
Feb 18, 2021
Messages
9
Office Version
  1. 365
Platform
  1. 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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
This line deletes data :

VBA Code:
timesheet_ws.Range(timesheet_ws.Cells(5, sunday_column), timesheet_ws.Cells(timesheet_lastrow, sunday_column + 13)).ClearContents
 
Upvote 0
Solution
This line deletes data :

VBA Code:
timesheet_ws.Range(timesheet_ws.Cells(5, sunday_column), timesheet_ws.Cells(timesheet_lastrow, sunday_column + 13)).ClearContents
Thanks, this is all kinda new to me and this macro is inhereted.
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top