By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
429,365 Members | 3,095 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 429,365 IT Pros & Developers. It's quick & easy.

VBA to open spreadsheet (name dynamic through var call), extract and process data

P: 1
Hi,

I am trying to get some VBA code working, but am preplex as to why it does not work. I would really appreciate any level of help.

Many thanks,
Mix01



Version of the program

Microsoft Excel 2003 Professional / Microsoft Visual Basic 6.3 version 9969 (VBA Retail 6.4.8869 / Forms3: 11.0.5601)


Purpose

There are a list of spreadsheet filepaths on worksheet AUTD, workbook TL7.xls. The code below should start at the top of this range and work its way through, opening a spreadsheet (name stored in variable 'AuthSheetName'), activate the 'AUT' worksheet, and extracting the last line of data on that worksheet (before any whitespace). The data includes two date fields, and two text fields.

Next, the background spreadsheet 'TL7.xls' should become activate, and the extrated data from the AUT worksheet from the background spreadsheet should be written onto the next available line (specified through a value, 'NextEntry') on the AUTD worksheet, workbook TL7.xls.

Once this is complete the background spreadsheet from which the data was originally extracted should close, and the next spreadsheet within the given range should open.

This process should go on until the conditions specified in the code below are met.


Expand|Select|Wrap|Line Numbers
  1. Sub StoreAuthData1()
  2.  
  3.     Dim NextEntry As Integer
  4.  
  5.     //1. AuthSheetName is a dynamic spreadsheet name. The value is retrieved and used to 
  6.  
  7. open a given spreadsheet.
  8.  
  9.     Dim AuthSheetName As String
  10.     Dim AUTROW, Col As Integer
  11.     Dim ThisRow As Long
  12.  
  13.  
  14.     //2. dont show spreadsheet processing
  15.  
  16.     Application.ScreenUpdating = False
  17.  
  18.  
  19.     ThisRow = 13
  20.  
  21.  
  22.     //3. set condition
  23.  
  24.     Do While ThisRow < 350
  25.     Workbooks("TL7.xls").Worksheets("AUTL").Activate
  26.  
  27.  
  28.     //4. Cells(ThisRow, 1).value refers to the value of cell "Row"/Column A, which trimmed 
  29.  
  30. spreadsheet names are held in
  31.  
  32.     AuthSheetName = Worksheets("AUTL").Cells(ThisRow, 1).Value
  33.  
  34.  
  35.     //5. keep going until blank is found
  36.  
  37.     If IsNull(AuthSheetName) Or Len(AuthSheetName) <= 0 Then Exit Do
  38.  
  39.  
  40.     //6. where to get the AuthSheetName data from             
  41.  
  42.         Workbooks.Open AuthSheetName
  43.         Workbooks(AuthSheetName).Worksheets("AUT").Activate
  44.         AUTROW = Worksheets("AUT").Cells(1, "E").Value - 1
  45.  
  46.  
  47.        //7. NextEntry is a dynamic value on AUTL worksheet that finds next blank line to put 
  48.  
  49. data from AUT data in on the AUTD worksheet. This is done through a cell formula on the AUTL 
  50.  
  51. worksheet =COUNTA(AUTD!B1:B3722)+1
  52.  
  53.         NextEntry = Workbooks("TL7.xls").Worksheets("AUTL").Cells(1, "I").Value
  54.  
  55.  
  56.            //8. put the AUT data in AUTL worksheet  
  57.  
  58.               For Col = 1 To 3
  59.  
  60.                 Workbooks("TL7.xls").Worksheets("AUTD").Cells(NextEntry, Col + 1).Value = _
  61.                 Worksheets("AUT").Cells(AUTROW, Col).Value
  62.  
  63.             Next Col
  64.  
  65.         Workbooks(AuthSheetName).Close
  66.  
  67.         Workbooks("TL7.xls").Worksheets("AUTD").Cells(NextEntry, "A").Value = _
  68.         Workbooks("TL7.xls").Worksheets("AUTL").Cells(programmerCount + 13, 4).Value  //9. 
  69.  
  70. programmerCount declared globally.
  71.  
  72.  
  73.         //10. increment
  74.  
  75.            ThisRow = ThisRow + 1
  76.  
  77.    Loop
  78.  
  79.     MsgBox "Authorisation complete.", vbInformation
  80.  
  81.   End Sub


--------------------------------------------------------------------------------


The code below is a function that trims the full filepath a given spreadsheet. The result of

"Z:\Shortcuts1\System\Trial\TSAB.xls" would be "TSTAB.xls". Refers to comment 4, above.


Expand|Select|Wrap|Line Numbers
  1. Function FunctionGetFileName(FullPath As String)
  2.  
  3. Dim StrFind As String
  4.     Do Until Left(StrFind, 1) = "\"
  5.         iCount = iCount + 1
  6.         StrFind = Right(FullPath, iCount)
  7.             If iCount = Len(FullPath) Then Exit Do
  8.     Loop
  9.  
  10.     FunctionGetFileName = Right(StrFind, Len(StrFind) - 1)
  11.  
  12. End Function



Expected output

Should write the data to the AUTD worksheet.



Error messages

Run-time error '1004':
'TSTAB.xls' could not be found. Check the spelling of the file name, and verify that the file location is correct.

The process is stopping when it tries to open the spreadsheet name assigned by the variable and thus is not extracting or writing any data.

The code was working before, however VBA gave an unexpected error and shut down. I had saved the code and tried again and this is the error I get now.


Other information

I have tried removing the variable call in the Workbook open line and replacing with both the trimmed filename and the full filepath. Both do not work.

Note - the file TSTAB.xls is in the given directory. It has not been moved even though it is giving the error that it is not in that location.

I have attempted to check if the file is actually there using the Dir function. The results are below:

Expand|Select|Wrap|Line Numbers
  1. Function Filecheck()
  2. Dim MyFile
  3.  
  4. 'Returns "MastertimeTrial2.xls" if it exists
  5. MyFile = Dir("Z:\Shortcuts1\System\Trial\TSTAB.")
The result of this is: MyFile = "Empty"


Expand|Select|Wrap|Line Numbers
  1. 'Returns filename with specified extension. If more than one *.xls
  2. 'file exists, the first file found is returned.
  3. MyFile = Dir("Z:\Shortcuts1\System\Trial\*.xls")
The result of this is: MyFile = "TSTAB.xls".


Expand|Select|Wrap|Line Numbers
  1. 'Call Dir again without arguments to return the next *.xls file in the
  2. 'same directory.
  3.  
  4. MyFile = Dir
  5. End Function
And the result of this is again: MyFile = "TSTAB.xls".



As a side, Im working on adding extra functionality to the above eventually. In brief, it will need to check a week ending value in the spreadsheets it is opening and closing, and validate this against a week ending date on the AUTD worksheet / TL7.xls spreadsheet. There is also a requirement to add an 'X' to cells to the right of the spreadsheet filepaths on the AUTD worksheet, for each week ending, when the above process has been completed for each spreadsheet, to show the process has been completed - in essence a checklist, of sorts..

I am currently working on this functionality, I am making slow progress between the hours of my job. However, if any of you are feeling extra kind and generous, I would appreciate any rough ideas for how I should approach this. :D


Many thanks for your time.

Mix01
May 30 '07 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.