Asim
Asim

Reputation: 105

Excel VBA correct date type for numbers?

I have a template that records hours worked by employees. Column 5 shows their contracted hours for the week and Column 14 shows additional hours they work. Part time staff (less than 37.5 hrs p/week) who work additional hours are paid a standard rate. However once they exceed 37.50 hours for the week they are paid at time and a half (this is recorded in a seperate column).

The code below picks up the total number of hours for the week (column 18) and if it exceeds 37.5 it will prompt the user to record some of the hours at time and a half. It's a failsafe way of ensuring people are paid correctly.

The code below works almost perfectly however if the contracted hours are less than 10, the message box pops up regardless. I think it is because I have a String data type for the hours in the code is as a String but I can't seem to get it to work with other data types. Any assistance would be much appreciated.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 14 Then

Dim I As Integer, CheckHours As Boolean
Dim MonthX As Worksheet
I = 6
CheckHours = False
Set MonthX = ThisWorkbook.ActiveSheet

Dim FT As String
FT = 37.5

Application.ScreenUpdating = False

'Use the Employee Number column to perform the check
Do While MonthX.Cells(I, 3) <> ""

    'Declare variables
        Dim ContractHours As String
        Dim HoursPaid As String
        Dim TotalHours As String

        ContractHours = MonthX.Cells(I, 5)     
        HoursPaid = MonthX.Cells(I, 14)
        TotalHours= MonthX.Cells(I, 18)

            'If the contract hours plus the additional hours are greater than 37.50 then display warning
            If TotalHours > FT Then
                MsgBox "WARNING: Check the additional hours entered for " & _
                MonthX.Cells(I, 2).Value & " " & MonthX.Cells(I, 1).Value & _
                " as they will need to be split between Additional Basic and Overtime." & _
                vbNewLine & vbNewLine & _
                "Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"

                CheckHours = True

            End If

    I = I + 1
Loop

'Cancel boolean
If CheckHours = True Then
    Cancel = True
    End If

Application.ScreenUpdating = True

End If

End Sub

Upvotes: 1

Views: 928

Answers (3)

Dick Kusleika
Dick Kusleika

Reputation: 33145

I don't know if your logic is right, but here's a rewrite that does the same thing as your code. There's a lot of extra stuff in your code that doesn't seem to have a purpose, so I removed it.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   Dim i As Long
   Dim dTotalHours As Double
   Dim aMsg(1 To 5) As String

   Const dFULLTIME As Double = 37.5

   i = 6

   If Target.Column = 14 Then
      Do While Len(Me.Cells(i, 3).Value) > 0
         dTotalHours = Me.Cells(i, 18).Value
         If dTotalHours > dFULLTIME Then
            aMsg(1) = "WARNING: Check the additional hours entered for"
            aMsg(2) = Me.Cells(i, 2).Value
            aMsg(3) = Me.Cells(i, 3).Value
            aMsg(4) = "as they will need to be split between Additional Basic and Overtime." & vbNewLine & vbNewLine
            aMsg(5) = "Please refer to the Additional Hours Guidelines tab for more information."

            MsgBox Join(aMsg, Space(1)), vbOKOnly, "Please Check"
         End If
         i = i + 1
      Loop
   End If

End Sub

Some notes

  • Excel stores numeric cell values as Doubles. If you're reading a number from a cell, there's really no reason to use anything but a Double.
  • When you're in the sheet's class module (where the events are), you can use the Me keyword to refer to the sheet. You refer to Activesheet, but what you really want is the sheet where the selection change occurred. They happen to be the same in this case, but for other events they may not be.
  • It's faster to check the length of a string rather than to check if <>"".
  • Your FT variable never changes making it not variable at all. A constant may be a better choice.
  • I use an array to store all the elements of a long message, then use Join to make the final string. Easier to read and maintain.
  • I'm a keyboard guy, so this hits closer to home for me that most, but a message box every time the selection changes? That means that if I attempt to use the arrow keys to get to the cell where I will fix the error, I will get constant message boxes. Brutal. Maybe the _Change event or _BeforeSave event are worth consideration.

Upvotes: 1

chuff
chuff

Reputation: 5866

The following code may need a bit of tweaking, but it should come close to what you need. It implements several of the suggestions in the comments to your question. The source of your difficulty was the use of string variables to deal with numeric values.

I've declared FT, ContractHours, HoursPaid, and SumHours as Single variables, and Cancel as a Boolean (although you don't use it in the subroutine).

You can set "Option Explicit" - which requires that variables be declared - as the default for your code by choosing Tools/Options from the menu bar of the VBA editor and then check-marking the "Require Variable Declaration" option on the Editor tab.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim i As Integer, CheckHours As Boolean, Cancel As Boolean
   Dim MonthX As Worksheet
   Dim FT As Single
   Dim ContractHours As Single
   Dim HoursPaid As Single
   Dim SumHours As Single
   Set MonthX = ThisWorkbook.ActiveSheet
   i = 6
   FT = 37.5
   If Target.Column = 14 Then
      Application.ScreenUpdating = False
      'Use the Employee Number column to perform the check
      Do While MonthX.Cells(i, 3).Value <> ""
         'Assign variables
         ContractHours = MonthX.Cells(i, 5).Value
         HoursPaid = MonthX.Cells(i, 14).Value
         SumHours = MonthX.Cells(i, 18).Value
         'When the contract hours plus the additional hours are greater than 37.50 
         '   display warning
         If SumHours > FT Then
            MsgBox "WARNING: Check the additional hours entered for " & _
               MonthX.Cells(i, 2).Value & " " & MonthX.Cells(i, 1).Value & _
               " as they will need to be split between Additional Basic and Overtime." & _
               vbNewLine & vbNewLine & _
               "Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
            CheckHours = True
         End If
         i = i + 1
      Loop
      'Cancel boolean
      If CheckHours = True Then
        Cancel = True
      End If
      Application.ScreenUpdating = True
   End If
End Sub

Upvotes: 0

Ashley Niall Coutts
Ashley Niall Coutts

Reputation: 102

Try declaring as a 'single' instead of a 'String'

We were told to declare decimal numbers as singles when at uni. It may solve your issue.

Or another thing I have notice but don't know if it will affect it, you don't have an ELSE with your IF statement

Upvotes: 0

Related Questions