Move query data to a new table using VBA

[Bob Blooms]

My opbjective is to eliminate an operation that is currently performed in Excel and move it to Access. I have an Access table that includes Employee Name, Account, Percentage. I have an Access query that calculates the cost of each employee. Using this data an other querty prorates the employee costs to each account. I need to get this data consisting of 195 employee and some 13 fields into three fields: Account, Cost Object, i.e., wage, fica, and a data field Cost. Currently I run the cost allocation query, export the data to Excel, run the marco which I have attached, then import it back to Access so that I can query it against actual costs for analysis.



I have never used VBA in Access so I need some handholding assistance. Don't have any idea where to start.

Sub Main()
' Creates allocation of costs for fte positions by Account
'Control screen updates
    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
'Clear Allocate worksheet
    Sheets("Allocate").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
        
'Develop listing by Name, Account and FTE allocation percentage, omitting cases with blank cells
    Dim myArray() As Variant 'array that will hold data from AutorizedPositions table
    Dim TheLastRow As Long 'holds the value of the last row with data
    Dim TheLastCol As Long 'holds the value of the last column with data
    Dim eRow As Integer 'points to the current active row to be written
    Dim Counter1 As Integer 'used to determine location by row in table
    Dim Counter2 As Integer 'used to determine location by column in table
'Setting up area to receive data and determine the area to be read into the array
    Sheets("AuthorizedPositions").Select
    TheLastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'Determine the number of rows filled
    TheLastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'Determine how many columns will have data
    
    myArray = Range(Cells(1, 1), Cells(TheLastRow, TheLastCol)).Value 'Reads data into array
    
    eRow = 2 'By starting with 2 the loop steps over Name
'Writes rows with data to worksheet creating a range of three columns
    For Counter1 = 2 To TheLastRow
        For Counter2 = 2 To TheLastCol
            If Not IsEmpty(myArray(Counter1, Counter2)) Then
                Range("AC" & eRow).Value = myArray(Counter1, Counter2)
                Range("AB" & eRow).Value = myArray(1, Counter2)
                Range("AA" & eRow).Value = myArray(Counter1, 1)
                eRow = eRow + 1
            End If
        Next Counter2
    Next Counter1
    Range("AA1").Value = "Name"
    Range("AB1").Value = "Account"
    Range("AC1").Value = "Allocate"
'Move listing to Allocate worksheet
    Range("A1").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Columns("AA:AC").Cut
    Sheets("Allocate").Select
    ActiveSheet.Paste
    Selection.Columns.AutoFit

End Sub

[June7]

One way to read/write data in tables is with VBA using recordsets. Here is one article http://msdn.microsoft.com/en-us/libr...ffice.12).aspx