convert excel worksheets to access records 1

[healthmj]

I'm sure this has been brought up before. My co worker has an excel sheet where the first column is employees names and the first row is project names. He fills in the intersecting cell, the hours that person works on that project. Every week he uses a new worksheet, hence the problem. Any suggestions would be helpful

Thanks in advance

Mike Jeansonne

 

[jksmi]

Hi,

is the problem that you want to batch convert his many existing spreadsheets into a database that you've created for him or your not too sure how to go about setting up the database, what tables are required etc...

HTH, Jamie
FAQ219-2884

 

[healthmj]

is the problem that you want to batch convert his many existing spreadsheets into a database -YES

that you've created for him. I HAVE NOT CREATED IT...YET

not too sure how to go about setting up the database, what tables are required etc... THAT IS CORRECT.

Again, thanks in advance

Mike Jeansonne

 

[jksmi]

Hi,

for your first problem, batch converting, you should be able to adapt the following, I use this by adding it to the module of a new workbook...

Public Sub Rebuild_Tables(ByVal vWorkbook As Variant, _
    ByVal vSheet As Variant, _
    Optional ByVal fDeleteFirst As Boolean = True)
Dim sRegion As String
Dim nRows As Long
Dim nCols As Long
Dim nOffsetY As Long
Dim nOffsetX As Long
Dim loop1 As Long
Dim loop2 As Long
Dim vCell As Variant
Dim aPhasing() As Variant
' Rebuild_Tables "RebuildTable.xls", "sheet1"
' Rebuild_Tables 1, 1, false
    
    On Error GoTo err_handler
    
    ' quick sanity check
    If Workbooks(vWorkbook).Name = ThisWorkbook.Name Then
        MsgBox "Cannot process " & ThisWorkbook.Name & vbCrLf & vbCrLf _
            & "Process will now quit...", vbCritical
            Exit Sub
    End If
   
    Application.ScreenUpdating = False      ' turn screenupdating off for speed
    
    With Workbooks(vWorkbook).Sheets(vSheet)
        ' get the region of the table from A1
        sRegion = .Cells(1, 1).CurrentRegion.Address
        nRows = .Range(sRegion).Rows.Count
        nCols = .Range(sRegion).Columns.Count
        ' set dimension of array
        ReDim aPhasing(nRows, nCols)
        nOffsetY = 1: nOffsetX = 1
        
        ' put table in an array
        While nOffsetY <= nRows
            While nOffsetX <= nCols
                vCell = .Cells(nOffsetY, nOffsetX)
                aPhasing(nOffsetY, nOffsetX) = vCell
                nOffsetX = nOffsetX + 1
                Wend
            nOffsetY = nOffsetY + 1
            nOffsetX = 1
            Wend
        End With        'sheets(1)
    
    ' update normalised table sheet with array
    With ThisWorkbook.Sheets(1)
        sRegion = .Cells(1, 1).CurrentRegion.Address
        
        If fDeleteFirst Then
            .Range(sRegion).EntireColumn.Delete       ' clear contents before continue
            nOffsetY = 2      ' set rows offset
            ' set column headings
            .Cells(1, 1) = "EMPLOYEE_NAME"
            .Cells(1, 2) = "PROJECT_NAME"
            .Cells(1, 3) = "HOURS_WORKED"
        Else
            nOffsetY = .Range(sRegion).Rows.Count + 1
        End If
        
        ' loop through comms in aPhasing (ignore headings, column1)
        For loop1 = 2 To nRows
            ' loop through weeks in aPhasing (start loop at first week ending, column8)
            For loop2 = 8 To nCols
                .Cells(nOffsetY, 1).Value = aPhasing(loop1, 1)   ' employee
                .Cells(nOffsetY, 2).Value = aPhasing(1, loop2)      ' project
                .Cells(nOffsetY, 3) = aPhasing(loop1, loop2)    ' hours worked
                nOffsetY = nOffsetY + 1     'next row
                Next loop2      ' next project
            Next loop1      ' next employee
        End With        'Sheets(1)
    
    Application.ScreenUpdating = True       ' turn screenupdating back on
    
    'save? nah...
Exit Sub

err_handler:
' msgbox and exit
MsgBox Err.Number & " : " & Err.Description, vbCritical, Err.Source, Err.HelpFile, Err.HelpContext
Debug.Print Err.Number, Err.Description

End Sub

there is the option to append multiple spreadsheets to the normalised table - but remember that Excel can only hold c.65k rows! if you think that you can do a few at a time without breaking 65k rows then you could use a wrapper function, i.e. open a few workbooks and run something like...

Public Sub Batch_Convert()
Dim fFirst As Boolean
Dim wbk As Workbook

For Each wbk In Workbooks
    If Not Workbooks(vWorkbook).Name = ThisWorkbook.Name Then
        Rebuild_Tables wbk.Name, 1, fFirst
        If fFirst Then fFirst = False
    End If
Next wbk

End Sub

With regards the tables that you require, it depends upon other information that you have available and what think you will use (i.e. if all your going to do is report employee hours worked you probably dont need all of their personal details). Also, if you can, I'd get your colleague to start using employee num before you get 2 employees with the same name! Generally speaking though you'd probably have a look up table for employee information, a look up table for project information, maybe a look up table for client information, a relationship table for clients to projects...

HTH, Jamie
FAQ219-2884