• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA script for arriving at current exams

K

Karthik Kaliappan

New Member
Hello all,

I kind of have a complex report to be built and I am thinking of using a VBA script to arrive at the report. So here is the snap shot of report and it is basically an exam schedule for a day. My team handles (team members name in column ‘O') these exams. Here is what I am trying to achieve:-

1. Trying to figure out the number of concurrent exams running at a given hour. We have exams running round the clock (24 hour setup) and I need to be able figure how many exams are being handled at a given hour. For example – So basically if I look at the number of current exams running at 08:00 AM it is 2 exams, at 09:00 AM it is 4 & at 10:00 AM it is 6 exams. We manually figure this out by looking at the exam start & end time respectively and assuming that all the exams start & end as per the scheduled time.
2. I am also looking at a similar report as above by the associate who is handling the exams.

I have uploaded a sample file of the exam schedule. Hope this helps.
 

Attachments

vletm said:
Karthik Kaliappan
Press [ Do It ] from cell P1
Note:
If 'Proctor' is as 'who is handling the exams' then You'll find those too.
Click to expand...

Hi,

Thanks for your script but I am running into an issue while I run the macro with a bigger data. The script runs totally fine during the start of the day but the calculations are wrong at the end of the day, particularly after 22:00 hours. I am attaching a larger data. Can you please look into it and help me?

Once again, I appreciate your help here.
 

Attachments

Karthik Kaliappan
I would always good to know:
what is wrong ... how to know - which tell for You that something is wrong...
not only that some are wrong ( missed wrong values eg highlite).
Your original sample data didn't have 'midnight' values!
I copied You 'new' data to my original file ... which has code.
Now, it would share those other way ... within one day!
 

Attachments

vletm said:
Karthik Kaliappan
I would always good to know:
what is wrong ... how to know - which tell for You that something is wrong...
not only that some are wrong ( missed wrong values eg highlite).
Your original sample data didn't have 'midnight' values!
I copied You 'new' data to my original file ... which has code.
Now, it would share those other way ... within one day!
Click to expand...
Thank you so very much for your effort. Very much appreciate it. Now it is all working fine.
 
vletm said:
Karthik Kaliappan
I would always good to know:
what is wrong ... how to know - which tell for You that something is wrong...
not only that some are wrong ( missed wrong values eg highlite).
Your original sample data didn't have 'midnight' values!
I copied You 'new' data to my original file ... which has code.
Now, it would share those other way ... within one day!
Click to expand...

Hello sir, I am back with a small query. Once again thanks for your help which you provided last time and it helped me immensely. I am trying to update the below macro which you helped me with. Just to give a little back ground, the below macro calculates the values for every 30 min interval. Now we would see the same for every 15 min interval, I tried to update a few things in the macro but obviously it didn't work.

Can you please help?

Code: 
Private Sub Do_It()
    On Error Resume Next
    Application.ScreenUpdating = False
    t30 = TimeSerial(0, 30, 0)
    With Sheets("Sheet2")
        .UsedRange.ClearContents
        For y = 0 To 47
            .Cells(6 + y, 2) = y * t30
        Next y
    End With
       
    a = 2
    Do
        Err.Clear
        With Sheets("sheet1")
            t_1 = .Cells(a, 1)
            t_2 = .Cells(a, 2)
            pro = .Cells(a, 15)
            a = a + 1
        End With
        With Sheets("sheet2")
            x = 4
            x = WorksheetFunction.Match(pro, .Range("5:5"), 0)
            If Err.Number <> 0 Then
                Do
                    x = x + 1
                Loop Until .Cells(5, x) = Empty
                .Cells(5, x) = pro
            End If
            org_t1 = t_1
            t_1 = t_1 - Int(t_1)
            y1 = Round(t_1 / t30, 0) + 6
'            t_2 = t_2 - Int(t_2)
            t_2 = t_2 - Int(org_t1)
            y2 = Round(t_2 / t30, 0) + 5
            For y = y1 To y2
                yy = y
                If yy > 53 Then yy = yy - 48
                .Cells(yy, 3) = .Cells(yy, 3) + 1
                .Cells(yy, x) = .Cells(yy, x) + 1
            Next y
        End With
    Loop Until Sheets("sheet1").Cells(a, 1) = Empty
    Sheets("Sheet2").Select
    Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Karthik Kaliappan
Is above an original code?
if 'yes' ... then without any testing!
change from t30 = TimeSerial(0, 30, 0) to t30 = TimeSerial(0, 15, 0)
There could be needed to more modifications or not!
ps. Before paste any code here, reread hints how to do it!
 
Thanks for replying. I tried this earlier but it didn't work. Please see the results in the attached file. I also tried to change this For y = 0 To 47 to For y = 0 To 95 and and all the t30 to t15, Still I had issues.
 

Attachments

great, thank you very much! I compared what I did and the what you gave. I made some mistake while editing the code. Now I understood. Thank you very much!!
 
You must log in or register to reply here.
Back
Top