Filling in Repeated Data from Excel source Table

[RogerCooper]

In order to compute commissions I need to read data from a spreadsheet provided by the customer. Unfortunately, the customer does not understand the first normal form and is not showing repeated data.

Sid Harvey Sid Harvey

Branch	Sid Item
0004 BROOKLYN,NY (0004) NY	SPE-EZ5E-CS
	SPE-HVLEZE
0007 HICKSVILLE,NY (0007) NY	RP-EZ-25
	SPE-EZ5E-CS
0009 FARMINGDALE,NY (0009) NY	SPE-EZDS-CS
	SPE-EZ5E-CS
	SPE-GS2E-CS
	SPE-HVLEZE

In order to process this, I need to fill in the null Branch field with the data that is above it. I know I can fix this from the Excel side, but I am wondering if there is a way of fixing this from the Access side. For example, is there a way recording the row number of the source spreadsheet within a query?

 

[plog]

For example, is there a way recording the row number of the source spreadsheet within a query?

Only if you provide it--insert a column before/after the data and have a cell compute it (A1=1, A2=A1+1, A3=A2+1, etc.). Two methods come to mind:

1. Build a macro in excel to fix this. You take one of these files, build a macro that loops from the first cell in the Branch column until the last and determines if a cell is blank, if so, copy the prior cells value to it. Then, you convert that spreadsheet into a template and every time you have to process data you import the new data to it, run the macro and then import into Access.

2. Build similar process in Access. Import the file into a temp table and include an autonumber primary key with it. Then for every blank record find the highest primary key of the row with a value before it and copy its Branch value to it.

 

[Gasman]

I might have something to help

I had to do something similar for a quicken export.

Edit: Here is how I did it. I had to export data from Quicken to Excel then to Access for further processing for EOY reports to assist my Divisional Secretary.
This however was run from Excel not Access.

HTH
Edit: And yes, I can now see how Move_Cursor could be improved.

Sub Access_input()
Dim iLast_Row As Integer, iSplit As Integer
iSplit = 0
'
' Access_input Macro
' Macro recorded 17/02/2011 by Paul Steel
'
' Keyboard Shortcut: Ctrl+i
'
' Check if we have splits or have not checked before running
    iSplit = MsgBox("Any Splits to process", vbYesNoCancel)
    If iSplit = 2 Then ' Cancel selected
        Exit Sub
    End If
   
'   Find top BALANCE row and delete
    ActiveSheet.Cells(1, 1).Select
    Cells.Find(What:="BALANCE ", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range(ActiveCell.Row & ":" & ActiveCell.Row - 1).Select
    Selection.Delete Shift:=xlUp
'   Find TOTAL field, select extra rows and delete
    Cells.Find(What:="TOTAL ", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range(ActiveCell.Row & ":" & ActiveCell.Row + 10).Select
    Selection.Delete Shift:=xlUp
'   Now format Amount column so no commas present
    Columns("I:I").Select
    Selection.NumberFormat = "0.00"
'   Now remove empty column A
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
   
' Now format for splits if they exist
    If iSplit = 6 Then ' Yes was selected
        Fill_Split
    End If
   
'   Sort by date
    Cells.Select
    Range("H91").Activate
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Now format the date column
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
' Make sure the Payee/Cheque number have no decimal places and trim the width
    Columns("C:C").Select
    Selection.NumberFormat = "0"
    Columns("C:C").ColumnWidth = 10
   
       
' And finally move the heading to the top
'    iLast_Row = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'    Range("A" & iLast_Row & ":Z" & iLast_Row).Select
'   Selection.Cut
'    Rows("1:1").Select
'    Selection.Insert Shift:=xlDown
   
'   Finally save the file
    Application.DisplayAlerts = False
    ChDir "C:\Users\PAUL\Documents\SSAFA"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\PAUL\Documents\SSAFA\Access Input.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
       
    Application.DisplayAlerts = True
   
End Sub
Sub Fill_Split()
    Dim Last_Row As Long
' Find last Row for loop
    Last_Row = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Now copy the data to rows left by the split function of Quicken
    Range("A1").Select
    Do While ActiveCell.Row < Last_Row
        Columns("A:A").Select
        Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Call Move_Cursor("Up")
        Range("A" & ActiveCell.Row & ":E" & ActiveCell.Row).Select
        Selection.Copy
        Range("A" & ActiveCell.Row + 1).Select
        ActiveSheet.Paste
Loop
   
End Sub

' Move cursor
Sub Move_Cursor(Direction As String, Optional varMoves)
Dim iMoves As Integer, iLoop As Integer
    If IsMissing(varMoves) Then
        iMoves = 1
    Else
        iMoves = varMoves
    End If
    For iLoop = 1 To iMoves
        Select Case Direction
            Case "Down"
                ActiveCell.Offset(1, 0).Select
            Case "Up"
                ActiveCell.Offset(-1, 0).Select
            Case "Right"
                ActiveCell.Offset(0, 1).Select
            Case "Left"
                ActiveCell.Offset(0, -1).Select
        End Select
    Next
End Sub

 

[MajP]

Access Fill Down to Emulate Excel Fill Down

Recently there was a user trying to emulate the Excel fill down functionality based on imported data. I am re-posting this solution here since I could see some utility and this may be a common issue. The OP mentioned doing several web searches and not finding an easy solution. The solution...

www.access-programmers.co.uk

 

[arnelgp]

' arnelgp
Private Sub sbUpdateBranch(ByVal workbookName As String, Optional ByVal sheetName As String = "sheet1")
    Dim rs As Object
    Dim sBranch As String
    Set rs = RecordSetFromSheet(workbookName, sheetName)
    With rs
        If Not (.BOF And .EOF) Then
            .MoveFirst
        End If
        Do Until .EOF
           If IsNull(!branch) Then
                !branch = sBranch
                .Update
            Else
                sBranch = !branch
            End If
            .MoveNext
        Loop
        .MoveFirst
    End With
    
    Dim xl_app As Object
    Dim xl_wkb As Object
    Dim xl_sht As Object
    
    Set xl_app = CreateObject("excel.application")
    Set xl_wkb = xl_app.workbooks.Open(workbookName)
    Set xl_sht = xl_wkb.worksheets(sheetName)
    
    With xl_sht
        .range("a2").copyfromrecordset rs
    End With
    rs.Close
    Set rs = Nothing
    
    Dim tmp As String
    tmp = Environ$("temp") & "\9452.xlsx"
    On Error Resume Next
    Kill tmp
    On Error GoTo 0
    xl_wkb.saveas tmp
    xl_wkb.Close
    
    Set xl_sht = Nothing
    Set xl_wkb = Nothing
    xl_app.Quit
    Set xl_app = Nothing
    
    VBA.Kill workbookName
    VBA.FileCopy tmp, workbookName
End Sub

' chatgpt
Public Function RecordSetFromSheet(ByVal WorkbookPath As String, ByVal sheetName As String, Optional ByVal criteria As String = "") As Object
    Dim rst As Object
    Dim cnx As Object
    Dim cmd As Object
    Dim sql As String
    
    Set rst = CreateObject("adodb.recordset")
    Set cnx = CreateObject("adodb.connection")
    Set cmd = CreateObject("adodb.command")
    
    ' Set up the connection
    '[HDR=Yes] means the field names are in the first row
    With cnx
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source='" & WorkbookPath & "'; " & "Extended Properties='Excel 12.0;HDR=Yes;IMEX=1'"
        .Open
    End With
    
    sql = "SELECT * FROM [" & sheetName & "$]"
    If Len(criteria) <> 0 Then
        sql = sql & " WHERE " & criteria
    End If
    sql = sql & ";"
    ' Set up the command
    Set cmd.ActiveConnection = cnx
    cmd.CommandType = 1                     'adCmdText
    cmd.CommandText = sql
    
    rst.CursorLocation = 3                  'adUseClient
    rst.CursorType = 2                      'adOpenDynamic
    rst.LockType = 3                        'adLockOptimistic
    
    ' Open the connection
    rst.Open cmd
    
    ' Disconnect the recordset
    Set rst.ActiveConnection = Nothing
    
    ' Clean up
    If CBool(cmd.State And 1) = True Then               'adStateOpen) = True Then
        Set cmd = Nothing
    End If
    '
    If CBool(cnx.State And 1) = True Then               'adStateOpen) = True Then
        cnx.Close
        Set cnx = Nothing
    End If
    
    ' "Return" the recordset object
    Set RecordSetFromSheet = rst
End Function

you need to close your workbook before you can update it.
to update the workbook:

Call sbUpdateBranch("workbookPathAndNameHere", "SheetNameHere")

 

[RogerCooper]

Thanks for the help. I used plog's second suggestion, of creating an autonumber field in a temporary table to import the data and then using a repeated query to fill in the data.