VBA hangs for seemingly no reason

[KAZSTREBOR]

Hi there, I am running into an issue where my code hangs up at a specific point and I have no idea why. I put a comment where it breaks. Any help would be greatly appreciated.

Sub Blue_Autofiller2()

'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 


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




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, 15))
    
For Each oCell In patient_names_to_trim
    oCell = Func.Trim(oCell)

'Hangs up at this point I have no idea why
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


'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 = 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

 

[Marc L]

Hi,​

​

maybe it is just working 'cause of the not such great idea to loop cell by cell when ranges have a lot of cells so this just needs some time …​