VBA to Define Range for Upload (1 Viewer)

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
I need help with this code. I have an excel worksheet that I will import into an access table. The range to be imported will change with each sheet. I'm 90% of the way there, I just need help getting across the finish line. My problem is this: the code below is supposed to find the last row with text and define the range between the last row and the starting cell. Unfortunately this code automatically calculates and names a range that ends 26 rows from where it's supposed to. Any help would be appreciated.

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lastRow As Long
Dim Range1 As Range
lastRow = Sheet1.Range("B77").End(xlUp).Row
'Let's assume your table begins at cell A3 and has two columns
Set Range1 = Sheet1.Range("B27").Resize(lastRow, 9)
Range1.Name = "WorkRequest"
Set Range1 = Nothing
End Sub
I tried to upload the file, but because it's a .xlsm file, the forum won't let me upload it.
 
Last edited:

namliam

The Mailman - AWF VIP
Joined
Aug 11, 2003
Messages
11,492
Unfortunately this code automatically calculates and names a range that ends 26 rows from where it's supposed to. Any help would be appreciated.

'Let's assume your table begins at cell A3 and has two columns
Set Range1 = Sheet1.Range("B27").Resize(lastRow, 9)
All of the underlined and bolded parts "go together"
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
I need the range to start in B27 and go 9 columns across the page. The "A3" you bolded was a part of a comment from the original code. I've put the new code below and removed the comment.

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lastRow As Long
Dim Range1 As Range
lastRow = Sheet1.Range("B77").End(xlUp).Row
Set Range1 = Sheet1.Range("B27").Resize(lastRow, 9)
Range1.Name = "WorkRequest"
Set Range1 = Nothing
End Sub
 

The_Doc_Man

Happy Retired Curmudgeon
Joined
Feb 28, 2001
Messages
15,594
This looks suspiciously like the problem posed by msk7777. It seems to be a class assignment from its appearance. We try to avoid doing class assignments since we don't get graded for them.
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
Definitely not a class assignment. Been out of college a number of years at this point. Essentially, I'm going to distribute an excel sheet that will allow various locations to submit a work order. Each item needing repaired will have it's own line item, but there's no telling how many lines will be in each worksheet. It would be far too tedious to open up each emailed worksheet (since there are well over 200 locations) and assign a static range. I have some code that will then take every saved worksheet in a specific folder and upload the range to an access table. I need to dynamically change the range, but access doesn't accept dynamic ranges.

The problem I'm running into here is that my range starts on "B27", but I have instructions for the locations in the rows above. When I run the code it basically reads from "B1", counts the rows down to "B27" and then adds the commensurate number of blank records to the new range. What I need to know is how to prevent it from adding those blank records to the range on only take into account the records in the range.
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
So I created a work around for my issue above. Instead of trying to make the named range start at "B27", I just moved the directions to their own sheet and made the named range start at "B1". This seems to have corrected the issue and now everything works as it should.

Now for my second issue. I have the code below which should import all the excel files in a given folder in my access table.

Code:
Public Function importExcelSheets(Directory As String, TableName As String) As Long
On Error Resume Next
 Dim strDir As String
 Dim strFile As String
 Dim I As Long
 I = 0
 If Left(Directory, 1) <> "\" Then
     strDir = Directory & "\"
 Else
     strDir = Directory
 End If
 strFile = Dir(strDir & "*.XLSX")
 While strFile <> ""
     I = I + 1
     strFile = strDir & strFile
     Debug.Print "importing " & strFile
    DoCmd.TransferSpreadsheet acImport, , TableName, tblWorkOrder, True, "WorkRequest!"
     strFile = Dir()
 Wend
 importExcelSheets = I
End Function
When I call the function in the immediate window, it does iterate through all the files in the specified folder, but it does not import any of the named range records into the table.

I attempted to trouble shoot this by creating a button and calling the transferspreadsheet protocol with a click. The code I used is:

Code:
Private Sub WorkOrdercmdBut_Click()
DoCmd.TransferSpreadsheet acImport, , "tblWorkOrder", "Z:\utilities\WorkOrders\RichmondVA05112016.xls", True, "Try!"
 End Sub
When I run it though, I get:

Run-Time error 3125:

'Try$' is not a valid name. Make sure that it does not include invalid characters or punctuation and that it is not too long.
I've uploaded a copy of the table that I'm trying to import.
 

Attachments

namliam

The Mailman - AWF VIP
Joined
Aug 11, 2003
Messages
11,492
I need the range to start in B27 and go 9 columns across the page. The "A3" you bolded was a part of a comment from the original code. I've put the new code below and removed the comment.
I guessed as much, however if you change one part of the code, you can expect the code to "misbehave" or behave differently from what you expect.

What I tried to point out is that you changed B1 to B27 and got an extra 26 lines. This is obviously due to the resize adding the number of lines that are stored in lastRow... substracting the surplus rows from lastRow should fix your problem
Set Range1 = Sheet1.Range("B27").Resize(lastRow - 26, 9)

I like to try and "teach a (wo)man to fish, instead of handing them a fish"

Code:
 If Left(Directory, 1) <> "\" Then
     strDir = Directory & "\"
Would you expect this to work? Let me tell you no, it doesn't work

If you are trying to import your named range WorkRequest ... try this
Code:
docmd.Transferspreadsheet acImport, acspreadsheettypeexcel7, "tablename", "Z:\utilities\WorkOrders\RichmondVA05112016.xls", true, "WorkRequest"
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
What I tried to point out is that you changed B1 to B27 and got an extra 26 lines. This is obviously due to the resize adding the number of lines that are stored in lastRow... substracting the surplus rows from lastRow should fix your problem
Set Range1 = Sheet1.Range("B27").Resize(lastRow - 26, 9)
This definitely makes sense and I will try to implement the change when I go to work this morning. It would be much easier for everything to be on one sheet instead of the directions on one and the work sheet on the other. Invariably, people will not look at the directions and assume the know what they're doing.

I'll play around with your suggestions a little as well and see if I can make them work.
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
Ok, so I've amended the method I'm using to this code I found here http://www.access-programmers.co.uk/forums/showthread.php?t=158308.

Below is how I've amended it:

Code:
 Private Sub WorkOrdercmdBut_Click()
  If MsgBox("This will open the Excel folder for spreadsheet imports.  Continue?", vbYesNoCancel) = vbYes Then
 Dim i As Integer
  Dim tblStr As String
    Dim varItem As Variant
 i = 1
tblStr = ""
       With Application.FileDialog(msoFileDialogFilePicker)
          With .Filters
           .Clear
           .Add "All Files", "*.*"
         End With
              .AllowMultiSelect = True
             .InitialFileName = "Z:\Utilities\WorkOrders"
             .InitialView = msoFileDialogViewDetails
                     If .Show Then
                       For Each varItem In .SelectedItems
                         For i = 1 To Len(varItem)
                          If IsNumeric(Mid(CStr(varItem), i, 1)) Then
                            tblStr = tblStr & Mid(CStr(varItem), i, 1)
                          End If
                        Next i
                         If Right(CStr(varItem), 4) = ".xlsm" Then
[COLOR=lime]                         [/COLOR][COLOR=red] DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblWorkOrder", CStr(varItem), True, "WorkRequest!"[/COLOR]
                            i = i + 1
                              DoCmd.OpenTable tblStr, acViewNormal, acReadOnly
                                MsgBox "Data Transferred Successfully!"
                                  DoCmd.Close
                                    tblStr = ""
                        End If
                       Next varItem
                    DoCmd.Close
                     End If
       End With
   End If
 End Sub
Everything works right up until the import. I can get the dialog box to open and I can select the files that I need, but when I click ok it does not import my named range. Does the problem lie here?

Code:
   i = i + 1
                              DoCmd.OpenTable tblStr, acViewNormal, acReadOnly
                                MsgBox "Data Transferred Successfully!"
                                  DoCmd.Close
                                    tblStr = ""
 

Squid1622

Registered User
Joined
May 14, 2012
Messages
49
namliam,

Thank you for all your help. I now have a function that does exactly what I want it to do. I was able to make the changes on the code myself and this is what I came up with.

Code:
 Private Sub WorkOrdercmdBut_Click()
  If MsgBox("This will open the Excel folder for spreadsheet imports.  Continue?", vbYesNoCancel) = vbYes Then
 Dim i As Integer
  Dim tblStr As String
    Dim varItem As Variant
 i = 1
tblStr = ""
       With Application.FileDialog(msoFileDialogFilePicker)
          With .Filters
           .Clear
           .Add "All Files", "*.*"
         End With
              .AllowMultiSelect = True
             .InitialFileName = "Z:\Utilities\WorkOrders"
             .InitialView = msoFileDialogViewDetails
                     If .Show Then
                       For Each varItem In .SelectedItems
                           DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblWorkOrder", CStr(varItem), True, "WorkRequest"
                            i = i + 1
                              DoCmd.OpenTable "tblWorkOrder", acViewNormal, acReadOnly
                                MsgBox "Data Transferred Successfully!"
                                  DoCmd.Close
                                    tblStr = ""
                     Next varItem
                    DoCmd.Close
                     End If
       End With
End If
 
End Sub
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom