VBA Macro to find Employee ID in another sheet then paste new data

BrisAdrian

New Member
Joined
Sep 5, 2015
Messages
22
Hello I'm trying to remove the potential of people messing up a database I've created when adding new employee details. This this end I've added a 'front page' type of set up that allows users to perform certain functions and will protect my database from user error.

Here is a miniature version of the database I'm using:
https://app.box.com/s/6e91emeyruqlkhgkdmmqlvrc8kvpwisu

My intent is for data to be entered into the sheet "Form" in cells B37 to AL37.
Then the "Add employee" button will search column "A" in the "Master" sheet for a match.
If a match exists an error message will pop up saying "This employee already exists"
If there is no match, the Employee ID number is added to the bottom of the Master list. From there the other fields from the New Employee Data series are added in sequence to the Employee ID number.

If my upload contains the code, there's some basic stuff I've worked in, but as I try to build more functionality into it I keep running up against a wall. Any help would be very much appreciated.

As an added request, I'm trying to retrieve the test results & dates, in revers from the master Data sheet and add them to the "Form" sheet when someone wants to "get history". So that AI14 will display the most recent date, AK14 the most recent result and any subsequent results are displayed in descending order up the whatever is in the "T" and "U" columns in the master data . This is so that I can provide employee's with a Graph representation of their results for easier comprehension.

What the sheet currently does:
Entering an existing employee's number in to G5 will bring up the available details, Entering data into G15 and G17 and then pressing "Update Results" will automatically populate the next 2 empty columns that correspond to that persons employee ID.
The "Clear Form" buttons reset the fields on the "Form" page.

The Previous results lookup lets you view the most recent result + date, the previous results, the difference between the two and the next test due date.

This may be of benefit to someone else who wishes to use the sheet. I've tried to add in explanations in the VBA codes so hopefully others can make use of it. However the "Update results" code is beyond my comprehension so if you are having trouble with that, I apologize.

Kindest Regards,
Adrian
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Hi Adrian,

In a standard module try this.
You can run from either Form sheet or Master, with a button, Shape or a Keyboard Short-Cut with Ctrl + ? (? = some un-reserved letter, upper or lower case)

I tried it on your example, but only after I unmerged ALL merged cells. You can use Center Across Selection under Format Cells, highly recommended.

Each entry in the input box is followed by a comma (,) and no space. To skip a column on the Master sheet during entry, use a single space then the comma and the next entry.

Howard

Code:
Option Explicit

Sub Inputbox_Comma()
Dim Empl_Info, i As Long
Dim myArr As Variant

Empl_Info = Application.InputBox(prompt:="Use a comma ( , ) as Delimiter" & vbCr & vbCr & _
            "Example - 12345,Name,Type etc." & vbCr & _
            "and a SPACE to skip an entry." & vbCr & vbCr & _
            "1 - Employee ID" & vbCr & _
            "2 - Name" & vbCr & _
            "3 - Title " & vbCr & _
            "5 - M/F Reproductive" & vbCr & _
            "6 - Contact" & vbCr & _
            "7 - Division" & vbCr & _
            "8 - Deptartment" & vbCr & _
            "9 - Section" & vbCr & _
            "10 - Supervisor" & vbCr & _
            "11 - Crew" & vbCr & _
            "12 - Role Description" & vbCr, _
            Title:="Employee Information New Entry", Type:=2)

   If Len(Empl_Info) = 0 Then
       MsgBox "No Entry"
       Exit Sub
   ElseIf Empl_Info = False Then
       Exit Sub
   End If

myArr = Split(Empl_Info, ",")

With Sheets("Master")
    .Cells(Rows.Count, 1).End(xlUp)(2) _
    .Resize(columnsize:=UBound(myArr) + 1) = myArr
End With

End Sub
 
Last edited:
Upvote 0
Hi Adrian
I have only had time to address the first part of your requirement.
Following code is not fully test but combines the Data Entry & Clear Functions for the Add New Employee Data part of Form & should work ok with your merged cells.
As always before testing any new code make a BACK-UP of your workbook.

Code:
Option Base 1
 Enum XLUserActionType
    xlNew
    xlClear
 End Enum


Sub clearnewstarter()
   AddData Action:=xlClear
    'this part returns to the first cell in the new starter block
    Range("B37").Select
End Sub


Sub save_New()
    AddData Action:=xlNew
End Sub


Sub AddData(ByVal Action As XLUserActionType)
    Dim EntryRange As Range, Item As Range, FoundCell As Range
    Dim EntryData() As Variant, Default As Variant
    Dim Search As String
    Dim i As Integer
    Dim LastRow As Long
    Dim wsMaster As Worksheet, wsForm As Worksheet
    
    With ThisWorkbook
        Set wsForm = .ActiveSheet
        Set wsMaster = .Worksheets("Master")
    End With
    
    Set EntryRange = wsForm.Range("B37,E37,J37,M37,Q37,R37,T37,X37,AC37,AG37,AJ37,AL37")
    
    Default = Array("Employee ID", "Employee Name", "EMP Type", "Position Title", _
                    "M/F", "Mobile Contact", "Division", "Department", _
                    "Section", "Supervisor", "Crew", "PRC Description")
    
Top:
    Select Case Action
    
    Case xlNew
    
    ReDim EntryData(1 To EntryRange.Cells.Count)
    
    Search = EntryRange.Cells(1, 1).Value
    
    If Len(Search) > 0 Then
    
        Set FoundCell = wsMaster.Columns(1).Find(Search, lookat:=xlWhole, LookIn:=xlValues)
    
        If FoundCell Is Nothing Then
        i = 1
        For Each Item In EntryRange
            'check each cell completed
            If Item.Value = Default(i) Or Item.Value = "" Then
                MsgBox Item.Value & Chr(10) & "Entry Required", 16, "Entry Required"
                wsForm.Cells(Item.Row, Item.Column).Select
                Exit Sub
            Else
                'add data to array
                EntryData(i) = Item.Value
            End If
            i = i + 1
        Next Item
        
        With wsMaster
            'find next empty row
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            'output array to range
            .Cells(LastRow, 1).Resize(1, UBound(EntryData)).Value = EntryData
        End With
            'inform user all ok
            MsgBox Search & Chr(10) & "New Record Added", 48, "New Record"
            'clear the form
            Action = xlClear: GoTo Top
        Else
            'Employee ID Exists
            MsgBox Search & Chr(10) & "Employee ID Record Already Exists", 48, "Record Exists"
        End If
    End If
    
    
    Case xlClear
        'clear record
        On Error Resume Next
        EntryRange.Cells.SpecialCells(xlCellTypeConstants).ClearContents
        On Error GoTo 0
        
        i = 1
        For Each Item In EntryRange
            'apply default values to merged cells
            Item.Value = Default(i)
            i = i + 1
        Next Item
    
    End Select


End Sub

I have added some data entry error checking to ensure that users do not enter your default values or leave cells blank.
If I get time will have a look at the other issue for you unless another her offers a solution.

NOTE: The Option Base 1 & Enum code which MUST sit at the TOP of your standard module outside of any procedure.

Hope Helpful

Dave
 
Last edited:
Upvote 0
WOW! That is amazing.

Thank you so much Dave.
Looking at that, it's clear to me I would not have been able to achieve what I originally set out.

I cant thank you enough, I'll be reading through that for a long time in order to get a better understanding of VBA.

Best Regards,
-Adrian
 
Upvote 0

Forum statistics

Threads
1,215,066
Messages
6,122,948
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top