I have two tables in excel, one named “Calendar” and the other one is named “PlanTable”the left table is named “Calendar” and the second is named “PlanTable”
What I am trying to do is to calculate how much should each worker do depending on what is the plan for a certain machine in that date. Let me give an example to maybe clarify what i’m trying to do.
Let’s say we take date 1-Jul-2024, we see that in the right table on that day the machines (under the “Utilaj” column)R1, R3 and R9 worked, beside each of them is the plan for the day(under the “Plan” column). After that we check the right table for how many workers were assigned to theR1, R3 thus R9 machines. After finding out that on 1-Jul-2024 there were 2 workers for R1, 1 for R3 and 3 for R9. The values beside each of the workers should be the (plan of the machine/count of workers that worked at it in the certain date).
I succeded into making this, but when i put a new person in the “Calendar” table, the values don’t move with the workers, and i can’t seem to figure how to do it. And if there is any optimization possible to my code to make it faster, i’m more than glad.
Here is my code below for the button: “Calculeaza Fapt” the fourth button.
Sub Refresh()
On Error GoTo ErrorHandler
Dim ws As Worksheet
Dim planTbl As ListObject
Dim calendarTbl As ListObject
Dim selectedDate As String
Dim utilaj As String
Dim r As Range
Dim cell As Range
Dim workerCount As Long
Dim planValue As Double
Dim faptValue As Double
Dim workerDict As Object
Dim utilajKey As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
Set planTbl = ws.ListObjects("PlanTable")
Set calendarTbl = ws.ListObjects("Calendar")
' Initialize dictionary to count workers
Set workerDict = CreateObject("Scripting.Dictionary")
' Loop through the dates in the PlanTable
For Each r In planTbl.ListColumns("Data").DataBodyRange
selectedDate = Format(r.Value, "dd-mmm-yy")
Debug.Print "Processing date: " & selectedDate
' Reset workerDict for each date
workerDict.RemoveAll
' Count the number of workers for each Utilaj on the selected date from the Calendar table
For Each cell In calendarTbl.ListColumns("Data").DataBodyRange
If Format(cell.Value, "dd-mmm-yy") = selectedDate Then
utilaj = cell.Offset(0, calendarTbl.ListColumns("Utilaj").Index - calendarTbl.ListColumns("Data").Index).Value
If workerDict.exists(utilaj) Then
workerDict(utilaj) = workerDict(utilaj) + 1
Else
workerDict.Add utilaj, 1
End If
End If
Next cell
' Debugging output
For Each utilajKey In workerDict.Keys
Debug.Print "Utilaj: " & utilajKey & ", Workers: " & workerDict(utilajKey)
Next utilajKey
' Divide the Plan value by the number of workers and assign to the Fapt column in the Calendar table
utilaj = r.Offset(0, planTbl.ListColumns("Utilaj").Index - planTbl.ListColumns("Data").Index).Value
planValue = r.Offset(0, planTbl.ListColumns("Plan").Index - planTbl.ListColumns("Data").Index).Value
If workerDict.exists(utilaj) Then
workerCount = workerDict(utilaj)
faptValue = planValue / workerCount
' Update the Calendar table
For Each cell In calendarTbl.ListColumns("Data").DataBodyRange
If Format(cell.Value, "dd-mmm-yy") = selectedDate And _
cell.Offset(0, calendarTbl.ListColumns("Utilaj").Index - calendarTbl.ListColumns("Data").Index).Value = utilaj Then
cell.Offset(0, calendarTbl.ListColumns("Plan").Index - calendarTbl.ListColumns("Data").Index).Value = faptValue
End If
Next cell
Debug.Print "Assigned Fapt value: " & faptValue & " to Utilaj: " & utilaj
Else
Debug.Print "No workers found for Utilaj: " & utilaj & " on date: " & selectedDate
End If
Next r
MsgBox "Values updated successfully!"
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
I tried using chatGpt hasn’t helped much
Dănilă Laurențiu is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.