Copying macro multiple times

[timlh42]

I have an employee sign in sheet that after they click on the button to sign out, the cells in that row all lock so no one can edit their info after they sign.

I have 4 cells that I check to make sure that they fill in before signing. My macro works great and it's exactly what I need. However, since I have the button click separate for each employee, I need to duplicate the macro 40 times.

Is there any way I can change to following code using offset or anything else rather than re-writing it for line 11, 12, 13 etc. all the way to 50?

Application.DisplayAlerts = False
On Error Resume Next

If Application.CountA(Range("I10,J10,K10,L10")) <> 4 Then
If Range("V10").Value = "COM" And Range("I10").Value = "" Then
MsgBox "Please enter number of commercial lifts", vbExclamation, "Required Entry"
Range("I10").Select
Exit Sub
ElseIf Range("V10").Value = "COM" And Range("J10").Value = "" Then
MsgBox "Please enter number of commercial yards", vbExclamation, "Required Entry"
Range("J10").Select
Exit Sub
ElseIf Range("V10").Value = "RESI" And Range("K10").Value = "" Then
MsgBox "Please enter number of resi drive bys", vbExclamation, "Required Entry"
Range("K10").Select
Exit Sub
ElseIf Range("V10").Value = "RO" And Range("L10").Value = "" Then
MsgBox "Please enter number of Boxes that were Dumped today", vbExclamation, "Required Entry"
Range("L10").Select
Exit Sub


End If
End If


Any help would be greatly appreciated.

 

[dmt32]

Hi,
should not need to repeat code - just create a function to manage the test for each user.


Place following in a STANDARD module

Option Base 1


Function IsComplete(ByVal CellRow As Long) As Boolean
    Dim ErrorMsg As String
    Dim i As Integer
    Dim arr As Variant, m As Variant


'check required cells completed
    If Application.CountA(Range("I" & CellRow & ",J" & CellRow & ",K" & CellRow & ",L" & CellRow)) <> 4 Then
        
        arr = Array("COM", "COM", "RESI", "RO")
        
        For i = 1 To 4
            With Cells(CellRow, 22)
                m = Application.Match(.Text, arr, False)
                If Not IsError(m) Then
                    If .Text = arr(m) And Len(Cells(CellRow, 8 + i).Text) = 0 Then
                        ErrorMsg = "Please enter number of " & Choose(i, "commercial lifts", _
                                                                        "commercial yards", _
                                                                        "resi drive bys", _
                                                                        "Boxes that were Dumped today")
                        Cells(CellRow, 8 + i).Select
                        Exit For
                    End If
                Else
                    .Select
                    ErrorMsg = "Entry Required."
                End If
            End With
        Next i
    End If
        
    IsComplete = CBool(Len(ErrorMsg) = 0)
    If Not IsComplete Then MsgBox ErrorMsg, 48, "Entry Required"
End Function

NOTE - Option Base 1 statement - This MUST site at the VERY TOP of the module OUTSIDE any procedure.
- Function ranges are unqualified & it is assumed that the required sheet is the activeheet.

To use function place following line of code in your button code(s) where you need to do the test

   If Not IsComplete(CellRow:=10) Then Exit Sub

The function has argument CellRow where you enter the row number as appropriate. If the Function returns false it will exit your code otherwise your code continues.



As a suggestion, rather than use lots of buttons you may be able use a listbox with all your staff names & use the listindex property to pass the required row to the function.


Hope Helpful

Dave

 

[timlh42]

Awesome!!!!

Thank You!!!