Big Request, need help before I pull my hair out.

[BrisAdrian]

I've been working on this monster (monster to me) Excel for over a month. I'm not an IT person (Paramedic by trade) and the bosses keep shifting the ground under my feet.

I've had some great help from a few people over the last week and I had what I thought was a workable solution.
I've sat down with the boss and told him that what we REALLY need is an Excel professional consultant to come in and do this. But they will not pay for it and I'm left struggling with this train wreck.

I need this database up and running so that I can get on with providing healthcare instead of laboriously entering data manually, and opening my self up to human error.

The Skeleton is there and to a degree it almost does what I need it to. But I keep tripping up in VBA.

So if you've read this far, and you have some time to kill here is the task at hand.

Here is what I currently have: https://app.box.com/s/1po645hp5t25y2ixdk5suif5fs3nf4ov

Task 1:
In Sheet: "Update"

Column	Purpose	Note
E2	Reference Cell	Find in Coulmn A of "Master" as reference point
E10	Date	Copy into a new instance starting in Column 'W' of master
E12	General Number	Copy into a new instance starting to the right of the date from [E10]. [E10]|[E12] need to go in sequence as a new entry every time this macro is run
E14	General Number	Bring up the value that is currently in Column 'V' in "Master" and replace that value with the value entered in [E14] every time this macro is run
E20	Date	Replace the value in 'M' of master sheet
E22	Text	Replace the value of 'O' in master sheet

<tbody>
</tbody>

Task 2:
In Sheet "Add"
Copy the data from all entry cells [E2],[E4],[E6],[E8] etc up to [E24].
Reference [E2]. If that number already exists in Column 'A' of "Master" bring up an alert and prevent the action from completing.
If it does not exist in Column 'A', enter the value of [E2] into the first empty row in 'A' of "Master". Then enter the remaining data from the Sheet "Add" to the adjacent cells in the matching row in "Master".
This macro also needs to copy the Formulas from "Master" Columns 'N','P',and 'U' down into the newly created Employee Data Row. (these formula's tell me when the employee's need particular health exams performed).
This macro also needs to reset all filters from "Master" before executing any data entry. Previously I had people entering people they thought were not in the list because they didn't realize they had filters on.
It would also be beneficial if the macro would auto fill any empty cells from the Sheet "Add" with "No Data" if a user fails to enter Data. Almost everyone that attempted to enter data complained that they did not have the data. It will be easier for me to Search "No Data" in the master sheet and then manually enter it at a later time, than to try and get 5 or 6 people to be proactive.

Task 3:
In Sheet "History
This one seems to be pretty much what I need. However I also need it to bring up the most recent results from an employee's "Master" record.
So that I can create a graph. Several people did not understand if their health was improving or not based on numerical data.
I tried some formulas to look at Column 'ZZ' in "Master" then look back to the first data entry. And bring that up ie:

Date	Result
1/5/15	8
1/4/15	5
1/1/14	6

<tbody>
</tbody>

Coming from a persons history that would be in "Master" as:

W	X	Y	Z	AA	AB
1/1/14	6	1/4/15	5	1/5/15	8

<tbody>
</tbody>

I could then us that to create a simple line graph on the "History" sheet.

Task 4:
In Sheet "EOM-Department"
Currently I am providing weekly reports to different managers by manually filtering departments, test type and then selecting any overdue tests and pasting that into an email for the bosses.
I have been trying to automate this on this sheet.
The goal is to use 2 Drop down lists and a parameter for one of those lists:
List 1: Departments (6 or so of these) List 2: Health Screen (3 of these, this is where I want there to be a parameter)

So that if I select [Management] and [Health Assessment] - (the parameter for health assessment being anything that was due before today) A list will be populated with the data of only those employee's to meet the criteria:

Have [Management] in their "Reporting Group"(Column 'G') on the "Master" sheet, AND have Health Assessments which are overdue Column 'N' for example.

Currently I set aside half to 3/4 of a day to give these reports to the relevant supervisors so that individuals can be notified. Yet they are plagued with human error.

The conditions I am trying to add in are based on the data in the "Master" sheet:
"Blood Lead Screening" Column 'R' is Date =<today()
"Blood Lead Result" Column "E"="m" AND "R"=>15 or <30 / "E"="f" AND "R"=>5 or <10
"Health Assessment" Column 'N' is Date =<today()
< TODAY()
"Blood Lead Testing" Column 'U' is Date = <TODAY()
I've uploaded it to Box with (hopefully) all Macro's included. Though I think they are a hindrance more than an aid since I have been attempting to tweak them to suit the new layout.

Any help is greatly appreciated, I will continue to read "Excel VBA Programming for dummies" and I will also continue to google the hell out of this, but with any luck one of you VBA Wizard will be able to get me over the line.

Special thanks to:
MARK858anddmt32 who's VBA I'm already using in the sheet, and was doing exactly what I needed it to. Before the goal posts got moved.</today()
</today()

 

[BrisAdrian]

Update:

Managed to tweak the code to add new employees:

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("E2,E4,E6,E8,E10,E12,E14,E16,E18,E20,E22,E24")
    
    Default = Array("Employee ID", "Employee Name", "No Data", "No Data", _
                    "No Data", "No Data", "No Data", "No Data", _
                    "No Data", "No Data", "No Data", "No Data")
    
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 = "" 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

So that now the default values are "No Data" which I can then find in the Master record try to update.
Still no luck with having the Formula's from Master!"N","P":"U" to drag down. But I am using record macro and trying to reverse engineer VBA.

Update:2
Turned the Master sheet into a Table and now the Formula's are automatically populating when a new user is added. Problem solved!

 

[BrisAdrian]

The 'Update' function is now working incorrectly because the data in "Master" is a table.

Sub update_blood_lead()    Dim strSearch As String, xrow As Long, lcol As Long


    strSearch = Sheets("Update").Range("E2")


    With Sheets("Master")


        With .Columns("A:A")
            .Replace " ", "", xlPart
            .Replace Chr(160), "", xlPart


            xrow = .Find(What:=strSearch, After:=Sheets("Master").Cells(1, 1), LookIn:=xlValues, _
                         lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
        End With


        lcol = .Cells(xrow, Columns.Count).End(xlToLeft).Column


        .Cells(xrow, "V").Value = Sheets("Update").Range("E14").Value
        Sheets("Update").Range("E10").Copy .Cells(xrow, lcol + 1)
        .Cells(xrow, lcol + 2).Value = Sheets("Update").Range("E12").Value


    Range("E2,E10,E12").Select
    Range("E14").Activate
    Selection.ClearContents
    Range("E14").Select
    Selection.ClearContents
     ActiveCell.Formula = _
        "=INDEX(Blood_Lead_Freq,MATCH($E$2,Master!$A:$A,0))"




    End With
End Sub

I guess in a table it's is considering each new column as an entry?

Link to Image of error: https://app.box.com/s/j3a1kihe0wkq1prv3h0b65jcp8bzb2kj

 

[BrisAdrian]

Another breakthrough.

The "Update" code now correctly enters Health Assessment Date & Type. Blood Test, Result, and Frequency.
But it's still adding a new column for every new Date & Result entry.

Sub TransferIt()    Dim strSearch As String, xrow As Long, lcol As Long


    strSearch = Sheets("Update").Range("E2")


    With Sheets("Master")


        With .Columns("A:A")
            .Replace " ", "", xlPart
            .Replace Chr(160), "", xlPart


            xrow = .Find(What:=strSearch, After:=Sheets("Master").Cells(1, 1), LookIn:=xlValues, _
                         lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
        End With


        lcol = .Cells(xrow, Columns.Count).End(xlToLeft).Column


    'Update Health Asssessment Date
        .Cells(xrow, "M").Value = Sheets("Update").Range("E20").Value
    'Update Health Assessment Type
        .Cells(xrow, "O").Value = Sheets("Update").Range("E22").Value
    'Update Blood Lead testing Frequency
        .Cells(xrow, "V").Value = Sheets("Update").Range("E14").Value
    'Update Blood Lead Test Date followed by Result
        Sheets("Update").Range("E10").Copy [COLOR=#ff0000].Cells(xrow, lcol + 1)[/COLOR]
        .Cells[COLOR=#ff0000](xrow, lcol + 2)[/COLOR].Value = Sheets("Update").Range("E12").Value
     
        
        
        
    'Reset Update sheet
        Worksheets("Update").Range("E2,E10,E12,E14,E20,E22").ClearContents
    'Returns Frequency display formula into E14 (this prevents frequency becoming 0 if data is not entered)
        Sheets("Update").[E14].Formula = "=INDEX(Blood_Lead_Freq,MATCH($E$2,Master!$A:$A,0))"
    'Displays Last Medical date in E20
        Sheets("Update").[E20].Formula = "=INDEX(HA_Performed,MATCH($E$2,Master!$A:$A,0))"
    'Displays Tupe of last medical in E22
        Sheets("Update").[E22].Formula = "=INDEX(HA_Type,MATCH($E$2,Master!$A:$A,0))"
        
        
        MsgBox Search & Chr(10) & "Record Updated", 48, "Record Updated"
        
                
    End With

I'm pretty sure the parts that I've highlighted red are the cause, because they seem to be going of 'column'?
I've been trying to find a way to go off Cells instead. Hoping that fixes the problem I'm having with the Table in "Master"

Any guidance would be very much appreciated. Thanks again for reading on!

 

[Myconservator]

Hey Adrian,

I see that you definitely have the motivation and dedication required to do this big task but you have to understand the mindset of people who would actually help you.

First off your problem is too broad and your question is very hard to find.
It is great that you have attached the file but start a thread with just one question.

You project description is so long that I ran out of patience (totally my fault) to help you.

 

[BrisAdrian]

Thanks for the reply Myconservator.

I've got most of it working (mostly.
I'll strip it down to the one that's got me completely stumped and hope for the best.

Thanks again!
-Adrian