Calendar to track lab test results 1

[jeannier1975]

I have a form that i for from old post that MapJ wrote but having a hard time getting the code to work. my form looks like the attachment . i have the following code that i am trying to input the dates depending on a year that is selected but i get an error. Run time error 424 Object required. I an very new to this and im going off at a whim. any help would be greatful.

 

[dhookom]

I hope your Access tables are not structured like your Excel file. How would you format the text box in your new form if you have more than one test result?

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[jeannier1975]

im still trying to work that out this is not mine it was just handed to me from the department manager

 

[dhookom]

I have created a similar database for work and it had a table for test types like I mentioned and a table for locations. The main transaction table had the location, test, date, and result. In your Excel file, every cell would potentially create a record in the transaction table.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[jeannier1975]

can you show me please i have been racking my head for weeks for a solution.

 

[dhookom]

I assume you have some type of hierarchy of your locations. Can you provide a description of the relationships?

This should provide a basic structure of tables I could discern from your spreadsheet. Once the tables are created you would write code to loop through the Excel file to populate them.

tblLocations
locLocID
locTitle

tblZones
zonZonID 1-4
zonTitle High Hygiene etc

tblSites
sitSitID
sitTitle
sitLocation

tblLines
linLinID
linTitle

tblSwabbers
swaSwaID "VL","MR","SA"
swaTitle "Velmer Lucid", "Mr. Rogers"
or
swaFirstName
swaLastName
swaEmployeeID

tblTests
tesTesID
tesTitle

tblResults
resResID
resSitID
resTesID
resResult


Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[dhookom]

Other than a couple entry errors it looks like Line and Location are the same.

[pre]
Line Location
PL2 Processng L2 (missing i)
PL3 Processing L2 (should be L3)[/pre]

Lines seem to be split into sites. Also each line can have one or more hygiene zones. Can a single site have multiple hygiene zones or is a specific site have only one hygiene designation?

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[dhookom]

Ok, the most difficult task is to normalize your data so that every cell creates a row with all the information on the left, the date, and the result. Once you get the data normalized you can import it into Access and create the master data tables and the results table.

So create a new worksheet named "Data" with these column titles in row 1.

Then open your Module1 and add this code at the top.

The code depends on some values in some cells and takes less than a minute to run on my PC.

Option Explicit
Public Const intLocation  As Integer = 1
Public Const intZone As Integer = 2
Public Const intSite As Integer = 3
Public Const intID As Integer = 4
Public Const intLine As Integer = 5
Public Const intSwabber As Integer = 6
Public Const intDate As Integer = 7
Public Const intData As Integer = 8

Sub ProcessData()
    Dim datStartProcessing As Date
    datStartProcessing = Now()
    Dim wks2019 As Worksheet
    Dim wksData As Worksheet
    Dim lngDataRow As Long
    Dim lng2019Row As Long
    Dim int2019Col As Integer
    Dim int2019LastRow As Integer
    Dim int2019LastCol As Integer
    Dim intDateRow As Integer
    Dim strLocation As String    'col 1
    Dim strZone As String        'col 2
    Dim strSite As String        'col 3
    Dim strID As String          'col 4
    Dim strLine As String        'col 5
    Dim strSwabber As String     'col 6
    Dim strResult As String      'store the swab result
    Dim datSwabDate As Date      'need to pull the date from top
    Dim intLocCol As Integer
    Set wks2019 = ThisWorkbook.Worksheets("2019 Listeria")
    Set wksData = ThisWorkbook.Worksheets("Data")
    int2019LastRow = wks2019.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    int2019LastCol = 407         [highlight #FCE94F]'you may need to change this when your data changes[/highlight]
    intDateRow = 4               'row of the date values
    lngDataRow = 2               'starting row for data
    lng2019Row = 6               'starting row for 2019 data
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Do Until strLocation = "DO NOT DELETE THIS ROW - USED FOR TALLY COUNT BELOW"
        strLocation = wks2019.Cells(lng2019Row, intLocation)
        If strLocation <> "DO NOT DELETE THIS ROW - USED FOR TALLY COUNT BELOW" Then
            strZone = wks2019.Cells(lng2019Row, intZone)
            strSite = wks2019.Cells(lng2019Row, intSite)
            strID = wks2019.Cells(lng2019Row, intID)
            strLine = wks2019.Cells(lng2019Row, intLine)
            strSwabber = wks2019.Cells(lng2019Row, intLine)
            Debug.Print "lng2019Row: " & lng2019Row
            For int2019Col = 7 To int2019LastCol
                datSwabDate = wks2019.Cells(intDateRow, int2019Col)
                wksData.Cells(lngDataRow, intLocation) = strLocation
                wksData.Cells(lngDataRow, intZone) = strZone
                wksData.Cells(lngDataRow, intSite) = strSite
                wksData.Cells(lngDataRow, intID) = strID
                wksData.Cells(lngDataRow, intLine) = strLine
                wksData.Cells(lngDataRow, intSwabber) = strSwabber
                wksData.Cells(lngDataRow, intDate) = datSwabDate
                wksData.Cells(lngDataRow, intData) = wks2019.Cells(lng2019Row, int2019Col)
                lngDataRow = lngDataRow + 1
            Next
        End If
        lng2019Row = lng2019Row + 1
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Debug.Print "Seconds: " & DateDiff("s", datStartProcessing, Now())
End Sub

To run the code, press Ctrl+G to open the immediate window and enter

ProcessData

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[jeannier1975]

i created the tables like you instructed but now how do i create a relationship between them how do i get the tables to be normalized.

 

[dhookom]

Did you attempt to implement the code I provided? I spent a fair amount of time writing and testing it. The code basically creates "records" on the Data worksheet which can then be pulled into Access to create the data for your tables.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[dhookom]

Row 127 has Processing L2 but the Line is PL3. Also Processing was spelled wrong in at least one row.

I modified the code some to force the ID column to text values since there are some numbers and some text. I also missed the Swabber column capture.

Here is the new code which you would run so you can link the Data worksheet into Access to append to your master data tables and transaction table.

Option Explicit
Public Const intLocation  As Integer = 1
Public Const intZone As Integer = 2
Public Const intSite As Integer = 3
Public Const intID As Integer = 4
Public Const intLine As Integer = 5
Public Const intSwabber As Integer = 6
Public Const intDate As Integer = 7
Public Const intData As Integer = 8

Sub ProcessData()
    Dim datStartProcessing As Date
    datStartProcessing = Now()
    Dim wks2019 As Worksheet
    Dim wksData As Worksheet
    Dim lngDataRow As Long
    Dim lng2019Row As Long
    Dim int2019Col As Integer
    Dim int2019LastRow As Integer
    Dim int2019LastCol As Integer
    Dim intDateRow As Integer
    Dim strLocation As String    [COLOR=#4E9A06]'col 1[/color]
    Dim strZone As String        [COLOR=#4E9A06]'col 2[/color]
    Dim strSite As String        [COLOR=#4E9A06]'col 3[/color]
    Dim strID As String          [COLOR=#4E9A06]'col 4[/color]
    Dim strLine As String        [COLOR=#4E9A06]'col 5[/color]
    Dim strSwabber As String     [COLOR=#4E9A06]'col 6[/color]
    Dim strResult As String      [COLOR=#4E9A06]'store the swab result[/color]
    Dim datSwabDate As Date      [COLOR=#4E9A06]'need to pull the date from top[/color]
    Dim intLocCol As Integer
    Set wks2019 = ThisWorkbook.Worksheets("2019 Listeria")
    Set wksData = ThisWorkbook.Worksheets("Data")
    int2019LastRow = wks2019.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    int2019LastCol =[highlight #FCE94F] 407[/highlight]         [COLOR=#4E9A06]'you may need to change this when your data changes[/color]
    intDateRow = 4               [COLOR=#4E9A06]'row of the date values[/color]
    lngDataRow = 2               [COLOR=#4E9A06]'starting row for data[/color]
    lng2019Row = 6               [COLOR=#4E9A06]'starting row for 2019 data[/color]
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Do Until strLocation = "DO NOT DELETE THIS ROW - USED FOR TALLY COUNT BELOW"
        strLocation = wks2019.Cells(lng2019Row, intLocation)
        If strLocation <> "DO NOT DELETE THIS ROW - USED FOR TALLY COUNT BELOW" Then
            strZone = wks2019.Cells(lng2019Row, intZone)
            strSite = wks2019.Cells(lng2019Row, intSite)
            strID = wks2019.Cells(lng2019Row, intID)
            strLine = wks2019.Cells(lng2019Row, intLine)
            strSwabber = wks2019.Cells(lng2019Row, intSwabber)
            Debug.Print "lng2019Row: " & lng2019Row
            For int2019Col = 7 To int2019LastCol
                datSwabDate = wks2019.Cells(intDateRow, int2019Col)
                wksData.Cells(lngDataRow, intLocation) = strLocation
                wksData.Cells(lngDataRow, intZone) = strZone
                wksData.Cells(lngDataRow, intSite) = strSite
                wksData.Cells(lngDataRow, intID) = "'" & strID  [COLOR=#4E9A06]'need to add apostrophe to convert to string[/color]
                wksData.Cells(lngDataRow, intLine) = strLine
                wksData.Cells(lngDataRow, intSwabber) = strSwabber
                wksData.Cells(lngDataRow, intDate) = datSwabDate
                wksData.Cells(lngDataRow, intData) = wks2019.Cells(lng2019Row, int2019Col)
                lngDataRow = lngDataRow + 1
            Next
        End If
        lng2019Row = lng2019Row + 1
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Debug.Print "Seconds: " & DateDiff("s", datStartProcessing, Now())
End Sub

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[Andrzejek]

Duane,
As a side note… Have you considered, instead of:

[pre]
Public Const intLocation As Integer = 1
Public Const intZone As Integer = 2
Public Const intSite As Integer = 3
Public Const intID As Integer = 4
Public Const intLine As Integer = 5
Public Const intSwabber As Integer = 6
Public Const intDate As Integer = 7
Public Const intData As Integer = 8
[/pre]
Use:
[pre]
Public Enum MyCol
intLocation = 1
intZone = 2
intSite = 3
intID = 4
intLine = 5
intSwabber = 6
intDate = 7
intData = 8
End Enum
[/pre]
Or – since Enum is (probably) 0 based, simply do:
[pre]
Public Enum MyCol
NotUsed
intLocation
intZone
intSite
intID
intLine
intSwabber
intDate
intData
End Enum[/pre]

So you can do:
[pre]
...
wksData.Cells(lngDataRow, [blue]MyCol.intLocation[/blue]) = strLocation
...
[/pre]
BTW, since it is used just in this Module, it does not have to be Public, Private should be enough.

I know it may just be a personal preference…



---- Andy

There is a great need for a sarcasm font.

 

[dhookom]

Hi Andy,
I don't typically use Enum but it's probably because I am old style. I had a bit of quandary regarding even using the Const since to a novice it might be confusing. I like the intellisense when typing MyCol.



Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[jeannier1975]

Sorry i had to be out for awhile due to surgery now im back at my project looking for help again.