Macro has working very slowly; How to speed up this macro.

[aneshdas]

Friends,

I am hereby attaching a sample worksheet. On this worksheet I am using an "Auto Present" macro on it. But that macro is working very slowly, Slowly means it is taking more than 5 seconds to process even though other macros are taking only fraction of a second. I don't know why this is so.
So, friends My actual requirement and code I generated are posting below. Kindly help me to sort out this issue

Actual Requirement of Mine.

"I have a spreadsheet for entering Employee's details. On that I am entering employee's daily attendance status. I AM USING DATA VALIDATION ON EACH EMPLOYEE STATUS CELLS. Means , I am selecting the status of employees from the Data validation List menu. It is almost 600 employees and entering each and every employee's status is a herculean task. So What I need is, I can enter on the Absent, Casual Leave, and etc...and the remaining unmarked staffs will be PRESENT. So that I need a command button for that purpose. So, when I clicked that button it should automatically apply "P" on the remaining cells on that particular date's column. More clearly, I have 31 columns for each day in a month and on each column's 7th ROW contains that particular day's date. So the macro has to search the empty CELL's between current date's particular column and fill it with "P" while I click the command button. The empty cells will be between 8th row to 500th row on each day's column. One more thing the macro has to check. The empty cell on each day has to fill ONLY IF that cells respective "B" cell having any value (Where the Employee Names entered). More clearly, I am entering Employees name in the "B" Column from 8 th to 500th row. So, After clicking the command button, macro has to find that particular date containing column and find the empty cells between that column's 8th ROW to 500th ROW and fill those empty CELLS with "P", ONLY IF there is any name in the B column."

MY VB CODE FOR AUTO PRESENT:-


Code:

Private Sub Button506_Click()

Application. EnableEvents = False 
Application.ScreenUpdating = False
    Dim BeginCol As Long
    Dim endCol As Long
    Dim ChkRow As Long
    Dim rng As Range
    Dim c As Variant



    BeginCol = 6
    endCol = 37
    ChkRow = 7
    For Colcnt = BeginCol To endCol
           If Sheets("Sheet1").Cells(ChkRow, Colcnt).Value = Date Then
            Set rng = Sheets("Sheet1").Cells(ChkRow, Colcnt).Rows("2:500")
            For Each c In rng
                If Sheets("Sheet1").Cells(c.Row, 2).Value = "" Then
                    c.Value = "P"
                End If
            Next c
        Else
            'Sheets("Sheet1").Cells(ChkRow, Colcnt).EntireColumn.Hidden = True
        End If
    Next Colcnt
    
    Application. EnableEvents = True
Application.ScreenUpdating = True
    
End Sub

[Bob Phillips]

It took less than 1/100th of a second for me. Evene clearing all the P values only took 1/4 of a second. It would seem you have something else causing the problem.

[D_Marcel]

I've tested also and it was very fast.