import access data into excel

[George Applegate]

I have a data base that looks like this in access:

emp# Date Time In or out

Obviously multiple records for each employee, on each date

I would like to somehow import the data into excel though, so it looks
like this:

emp# date In Tim 1 Out tim 1 In tim 2 Out tim 2 In tim3 Out tim 3

In other words, when the date comes into excel from access, how can I
get the multiple ins and outs for a day on the same line if it's the
same date??? Do I have to write some sort of visual basic program, or
is there an easy way to do this?

I'd appreciate all suggestions

thanks,
ga

George Applegate
(e-mail address removed)

 

[JLatham]

George,
I think this will work for you. I didn't actually set up a database and
import data, but I did enter some data to simulate that with the Employee# in
column A, a date (formatted as a date) in column B, and in/out times
(formatted in a Time format) in columns C and D.

This code goes into a regular code module, and before running it you should
make sure that the source data imported from Access is sorted by Employee#,
Date and In-time so that the results make sense when the code runs. Rows on
the destination sheet will be based on a Name/Date match followed by all
in/out times for that date for that person.

To get the code into your Excel workbook; press [Alt]+[F11] to open the VB
Editor, choose Insert | Module and copy the code below and paste it into the
module presented to you. Make any changes needed to the sheet names defined
in the code. Import your data (if you haven't already), sort it, and then
use
Tools | Macro | Macros to select and run this macro.

Sub TransposeInOutTimes()
'list on source sheet (Sheet1) must be sorted by:
' Name then by Date then by Time In
'before running this process
Const sourceSheetName = "Sheet1" ' change if necessary
Const destSheetName = "Sheet2" ' change if necessary
Const firstNameRow = 2 ' assumes row 1 has labels
Dim sourceSheet As Worksheet
Dim empNumberList As Range
Dim anyEmpNumber As Range

Dim destSheet As Worksheet
Dim destBaseCell As Range
Dim currentEmpNumber As String
Dim currentDate As Date
Dim destRowOffset As Long
Dim destColOffset As Long

Set sourceSheet = Worksheets(sourceSheetName)
Set destSheet = Worksheets(destSheetName)
Set empNumberList = sourceSheet.Range("A" & firstNameRow & ":" _
& sourceSheet.Range("A" & Rows.Count).End(xlUp).Address)
destSheet.Cells.ClearContents ' erase old information
Set destBaseCell = destSheet.Range("A2") ' start on row 2
destRowOffset = -1 ' initialize
For Each anyEmpNumber In empNumberList
If anyEmpNumber <> currentEmpNumber Then
'must begin a new row on destSheet
destRowOffset = destRowOffset + 1
currentEmpNumber = anyEmpNumber ' save this name
currentDate = anyEmpNumber.Offset(0, 1) ' get first date
destBaseCell.Offset(destRowOffset, 0) = currentEmpNumber
destBaseCell.Offset(destRowOffset, 1) = currentDate
'and get the 1st 2 In/Out times
destBaseCell.Offset(destRowOffset, 2) = anyEmpNumber.Offset(0, 2)
destBaseCell.Offset(destRowOffset, 3) = anyEmpNumber.Offset(0, 3)
destColOffset = 4 ' reset
Else
'emp# matched, check for new date
If anyEmpNumber.Offset(0, 1) <> currentDate Then
'must start new row for same person
destRowOffset = destRowOffset + 1
currentDate = anyEmpNumber.Offset(0, 1) ' save date
destBaseCell.Offset(destRowOffset, 0) = currentEmpNumber
destBaseCell.Offset(destRowOffset, 1) = currentDate
'and get the 1st 2 In/Out times
destBaseCell.Offset(destRowOffset, 2) = anyEmpNumber.Offset(0, 2)
destBaseCell.Offset(destRowOffset, 3) = anyEmpNumber.Offset(0, 3)
destColOffset = 4 ' reset
Else
'same emp#, and date, just add In/Out times to the row
destBaseCell.Offset(destRowOffset, destColOffset) = _
anyEmpNumber.Offset(0, 2)
destColOffset = destColOffset + 1
destBaseCell.Offset(destRowOffset, destColOffset) = _
anyEmpNumber.Offset(0, 3)
destColOffset = destColOffset + 1
End If
End If ' end of emp# match test
Next ' move to next row on the Source Sheet
End Sub