Group by data found in multiple fields

[clarencelai]

Hello..

I have a table of availability submitted by part-timers for various dates. The availability options are "Available" , "Morning" and "Not Available".

I would like to create a query to count the number of Available, Morning and Not Available.

I have attached sample of the table and the desired query result for your advice.

Thanks
Clarence
[IMGNOTHUMB]https://bytes.com/attachments/attachment/8788d1467856148/groupbyavailabi lity.jpg[/IMGNOTHUMB]

[NeoPa]

I'm afraid that's a perfect example of how not to store such data - with a bonus illustration of the main reason included.

I recommend checking out Database Normalisation and Table Structures. I'm afraid there are certain situations where you just have to know how to do things properly as there's no other way without extreme pain. You've hit on one of them here I'm sorry to say.

At least it gives you the opportunity to learn something important and avoid such design issues in any future work.

[clarencelai]

Thank you for your advice.

The data was collected via Google Form / Sheets in a grid question format and imported into MS Access. I was hoping I can utilize the data collected.

[NeoPa]

You can do Clarence, but stored data and displayed data are often completely different animals.

I would suggest that you import the data as a first step into a temporary (or holding) table. Once imported run a (or some) query to convert the data into tables designed to hold it properly. Properly designed tables give you much more scope to process and display your data, such that you won't be held up by such limitations.

[clarencelai]

Thanks for your advice, NeoPa.

[jforbes]

I would agree with NeoPa that attempting to query against that data in the form that it is in would just not be practical. If at all possible, see if you can get the data in a different format where it is normalized.

But sometimes you just can't control the data source. I have a similar situation here where we needed to report against some forecast information supplied to us by a couple different customers. The information supplied to us was basically a report in an Excel Spreadsheet. It being in Excel is different than what you are running into, but the data was in a similar tabular form (pivot table). Typically the data was structured so the first few columns are descriptive and then the next n columns had a date header with the counts needed for those dates.


The following routine is what I wrote to import that data into a normalized table structure, so that we could create reports that we needed. I wrote it quickly and there are a few things that I could do to make the code more solid, but they have been using it for 6 months without incident, so I'm just leaving it alone. I don't know if it will help you or not. I hope it will.

Private Sub btnImport_Click()
On Error GoTo ErrorOut

    Dim sSQL As String
    Dim oForcast As clsForcast
    Dim sSpreadsheet As String
    
    Dim oExcel As Excel.Application
    Dim oWorkbook As Excel.Workbook
    Dim oSheets As Excel.Sheets
    Dim oSheet As Excel.Worksheet
    
    Dim oRow As Excel.Range
    
    Dim iCount As Integer
    Dim iCount2 As Integer
    Dim iColumnCount As Integer
    Dim iMaxColumns As Integer
    Dim oHeader As New Collection
    Dim oDays As New Collection
    Dim sCustomer As String
    Dim iItemNumber As Integer
    Dim iDescription As Integer
    Dim iSupplierNumber As Integer
    Dim sTempHeader As String
    Dim sTempItemNumber As String
    Dim oDate As New clsNameValueIntDate
    Dim iInsertCount As Long
                
            
    sCustomer = Nz(Me.cboCustomer.Value, "")
    sSpreadsheet = Nz(Me.txtFileName.Value, "")
    
    If Len(sCustomer) = 0 Then
        MsgBox "Please supply a customer to import against."
        GoTo ExitOut
    End If
    
    If Len(sSpreadsheet) = 0 Then
        MsgBox "Please select a file to import."
        GoTo ExitOut
    End If
    
    ' Clear out old Imports
    sSQL = ""
    sSQL = sSQL & "DELETE FROM tblCoolerForcast "
    sSQL = sSQL & "WHERE Customer='" & sCustomer & "'"
    Call executeSQL(sSQL)
    
    
    If Not fileExists(sSpreadsheet) Then
        Call MsgBox("The File '" & sSpreadsheet & "' Could not be located.")
    Else
        Set oExcel = New Excel.Application
        Set oWorkbook = oExcel.Workbooks.Open(sSpreadsheet, ReadOnly:=True)
        Set oSheets = oWorkbook.Sheets
        Set oSheet = oWorkbook.Sheets(1)
           
        ' Determine Column Locations and Supplied Dates
        iCount = 1
        iCount2 = 1
        Do While Len(Trim(sTempHeader)) > 0 Or iCount = 1
            Set oRow = oSheet.Cells(1, iCount)                  ' Get Header
            sTempHeader = Nz(oRow.Text, "")
            If Len(sTempHeader) = 0 Then
            Else
                Call oHeader.Add(sTempHeader, CStr(iCount))     ' Determine header
                Select Case Trim(sTempHeader)                   ' Determine what Header is Where,
                    Case "Item Number"                          ' incase the Columns get reordered
                        iItemNumber = iCount
                    Case "Description"
                        iDescription = iCount
                    Case "Supplier Item Number"
                        iSupplierNumber = iCount
                    Case "Leadtime Level"
                    Case "UM"
                    Case "Quantity        On-Hand"
                    Case "Safety Stock"
                    Case "Past Due"
                    Case Else
                        If IsDate(sTempHeader) Then             ' Save of the Date for Date Headers
                            Set oDate = New clsNameValueIntDate
                            oDate.dDate = sTempHeader
                            oDate.iInteger = iCount
                            Call oDays.Add(oDate, CStr(iCount2))
                            iCount2 = iCount2 + 1
                        End If
                End Select
            End If
            iCount = iCount + 1
        Loop
        iMaxColumns = iCount
        
        
        ' Get the Data
        iCount = 2
        Do While Len(Trim(sTempItemNumber)) > 0 Or iCount = 2
            sTempItemNumber = oSheet.Cells(iCount, iItemNumber)
            If Len(sTempItemNumber) = 0 Then
            Else
                For iCount2 = 1 To oDays.Count                      ' Loop Through Dates
                    Set oForcast = New clsForcast
                    oForcast.Quantity = oSheet.Cells(iCount, oDays.Item(iCount2).iInteger)
                    If oForcast.Quantity <> 0 Then                  ' Skip if Quantiy is Zero
                        
                        oForcast.ItemNumber = oSheet.Cells(iCount, iItemNumber)
                        oForcast.Description = oSheet.Cells(iCount, iDescription)
                        oForcast.SupplierPartNumber = oSheet.Cells(iCount, iSupplierNumber)
                        oForcast.RequiredDate = oDays.Item(iCount2).dDate
                        
                        sSQL = ""
                        sSQL = sSQL & "INSERT INTO tblCoolerForcast ( "
                        sSQL = sSQL & "  Customer "
                        sSQL = sSQL & ", CustomerPartNumber "
                        sSQL = sSQL & ", Description "
                        sSQL = sSQL & ", SupplierPartNumber "
                        sSQL = sSQL & ", RequiredDate "
                        sSQL = sSQL & ", Quantity "
                        sSQL = sSQL & ") VALUES ( "
                        sSQL = sSQL & "  '" & Replace(sCustomer, "'", "") & "' "
                        sSQL = sSQL & ", '" & Replace(sTempItemNumber, "'", "") & "' "
                        sSQL = sSQL & ", '" & Replace(oForcast.Description, "'", "") & "' "
                        sSQL = sSQL & ", '" & oForcast.SupplierPartNumber & "' "
                        sSQL = sSQL & ", #" & oForcast.RequiredDate & "# "
                        sSQL = sSQL & ", " & oForcast.Quantity & " "
                        sSQL = sSQL & ") "
                        
                        Call executeSQL(sSQL)
                        iInsertCount = iInsertCount + 1
                    End If
                Next iCount2
            End If
            
            iCount = iCount + 1
        Loop
    End If
    
    ' Update Last Lmport Date
    sSQL = ""
    sSQL = sSQL & "INSERT INTO tblLastImportDates ( "
    sSQL = sSQL & "  Customer "
    sSQL = sSQL & ", LastImport "
    sSQL = sSQL & ") VALUES ( "
    sSQL = sSQL & "  '" & sCustomer & "' "
    sSQL = sSQL & ", #" & Now() & "# "
    sSQL = sSQL & ") "
                    
    Call executeSQL(sSQL)
    Call MsgBox(iInsertCount & " records were inserted for '" & sCustomer & "'")
    
ExitOut:
    If Not oWorkbook Is Nothing Then
        oWorkbook.Close SaveChanges:=False
        Set oWorkbook = Nothing
    End If
    If Not oExcel Is Nothing Then
        oExcel.Quit
        Set oExcel = Nothing
    End If
Exit Sub

ErrorOut:
    MsgBox "There was an error importing the Spreadsheet '" & sSpreadsheet & "'." & vbCrLf & vbCrLf & Err.Description
    GoTo ExitOut
End Sub

[clarencelai]

Thanks for sharing your experience with me. Yes, I wished I have better control with the data source.

Thanks for the codes. I am not very familiar with VBA so I tried to duplicate yours and see how I can amend it later to suit my purpose.

1. I created a spreadsheet with the same fields provided in your Excelimport.jpg .

2. Created a button in MS Access with an event procedure that runs your code.

I encountered an error when I clicked on the import button.

Error message: Compile Error: User-Defined Type not Defined.

Dim oForcast As clsForcast

clsForcast was highlighted.

Please advise if I have missed out adding any references. I have attached the references added in my MS Access.

[jforbes]

I apologize for not including the class and for not responding earlier. I'm not feeling to hot, so I took yesterday off from pretty much everything.

I didn't expect for you to try to get the code that I provided to work on your system, so I didn't spend a lot of time making sure everything thing was there to get it going.

Since you are, here ya go...

This is the clsForcast Class Module that it is using. It's basically a group of properties and no code:

Option Compare Database
Option Explicit

Public Customer As String
Public ItemNumber As String
Public CustomerPartNumber As String
Public Description As String
Public SupplierPartNumber As String
Public LeadtimeLevel As String
Public RequiredDate As Date
Public Quantity As Integer

Along the same lines, there is another properties only class module being used, called clsNameValueInt Date:

Option Compare Database
Option Explicit

Public iInteger As Integer
Public dDate As Date

There is also a Method that is being called to execute some SQL called executeSQL. It should be located in a Standard Module (or the Form if you just want to test it). This is a function that I use often just to keep the code looking cleaner an it's also easier for me to remember the syntax. It's a little more complex than this, but I simplified it so as not to have to include a bunch more code:

Public Sub executeSQL(ByRef sSQL As String)
    On Error GoTo ErrorOut
    CurrentDB.Execute sSQL, dbFailOnError + dbSeeChanges
ExitOut:
    Exit Sub
ErrorOut:
    Call msgBox("Could not execute SQL: " & vbCrLf & vbCrLf & sSQL & vbCrLf & vbCrLf & Err.Description)
    Resume ExitOut
End Sub

There is also this method that could be included in the same Module as executeSQL:

Function fileExists(ByVal strFile As String, Optional bFindFolders As Boolean = False) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    'If Dir() returns something, the file exists.
    On Error Resume Next
    fileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function

Lastly, here's a screen shot of the references. I don't think you will need the Microsoft Scripting Runtime reference:

[clarencelai]

Thanks again for responding to my questions. I hope you are getting better.

I am afraid that my knowledge about VBA is limited to fully appreciate the work you have done.

After heeding your advice to insert the 2 class modules (clsforcast and clsNameValueInt Date) and the procedure (executeSQL), the program run a little further and hit another error where it says FileExists 'Sub or Function not defined'.

Do rest well and only answer to my question when you find the time.

Thank you.

[jforbes]

Thanks for the well wishing.

Ah, I realized I didn't include the code for the fileExists Method right after I posted the response. I immediately edited the post and added the fileExists Method, but you were faster than I was.

So to save us both some time and to help anyone else who may read this thread later, I've attached a Sample Database and Sample Data so you can get up and running quicker.

I think it's pretty straight forward, but feel free to ask questions.

[clarencelai]

Thanks for sharing the sample database and data. It's really cool!

This will definitely help to resolve the issue I have no hand now.

Thanks much!
Clarence