Excel 2010 - Collect and import data Problem 3

[Walter349]

I have a bit of a problem. The following code does everything, except actually bring the data from the source to the destination.

-What its supposed to do:
It is intended to open a directory listing and allow selection of specific workbook/s to be processed.
Then to collect data from specific cells in each workbook selected on a specified sheet.
Then store the collected data to the destination workbook.
Then close the source workbook and move onto the next selected workbook until the end of the selected workbooks, doing the same thing.

-What happens:
1. The directory opens and allows selection of the source workbooks.
2. It goes through until all workbooks selected have been processed and says Data import completed.
3. It does not import any data.

I have watched the rng variable during the process and it remains at 'nothing'. It appears that the data source is not actually being addressed.
Does anyone have any idea what I am doing wrong here?

Sub importFPRptData()

Dim X As Long, Z As Variant, Y As Variant
Dim Bk As Workbook, Sh As Worksheet, Sh1 As Worksheet
Dim rng As Range
Dim rng1 As Range

Set Sh = Workbooks("FP Report.xlsm").Worksheets("Data") 'Destination

Application.ScreenUpdating = False

'Get the fields to be used for extracting data.

Z = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
If Not IsArray(Z) Then
    MsgBox "Nothing was selected"
    Exit Sub
End If

For X = 1 To UBound(Z)

    Set Bk = Workbooks.Open(Z(X))

    On Error Resume Next
        Set Sh1 = Bk.Worksheets(Sheet2) ' The data source sheet in the source report

    On Error GoTo 0

    If Not Sh1 Is Nothing Then

        Set rng = Sh1.Range("I5") 'Name
        Set rng1 = Sh.Cells(Rows.Count, 1).End(xlUp)(2)
        If rng = "" Then
        rng = "N/K"
        rng1.Copy
        rng1.PasteSpecial xlValues
        Else
        rng.Copy
        rng1.PasteSpecial xlValues
        End If

        Set rng = Sh1.Range("I6") 'DOB
        Set rng1 = Sh.Cells(Rows.Count, 2).End(xlUp)(2)
        If rng = "" Then
        rng = "N/K"
        rng1.Copy
        rng1.PasteSpecial xlValues
        Else
        rng.Copy
        rng1.PasteSpecial xlValues
        End If

        Set rng = Sh1.Range("I8") 'Nationality
        Set rng1 = Sh.Cells(Rows.Count, 3).End(xlUp)(2)
        If rng = "" Then
        rng = "N/K"
        rng1.Copy
        rng1.PasteSpecial xlValues
        Else
        rng.Copy
        rng1.PasteSpecial xlValues
        End If
    
    End If

    Bk.Close

Next X

MsgBox "The Data import is complete"

End Sub

'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

hi,

Your copy 'n' pastes code works just fine, putting data in columns A:C in the SH object.

Can you STEP thru the procedure and observe what is happeneing?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Walter349]

Hi Skip,

I have stepped through it and watched the values for rng and rng1.

It seems that it is hitting the 'If Not Sh1 Is Nothing Then' statement, after opening the source document, then going straight to the 'End If' statement, bypassing the 'copy/paste' statements entirely.

I tried creating a plain vanilla source workbook and changed the copy/paste statements to read from A1, A2 & A3 on sheet two of the source workbook and selected that workbook, thinking lets simplify this, but with the same results.

It goes through the motions, opens the selected workbook/s but does not copy the data from the specified cells.

rng and rng1 remain at nothing.

Its as if it is not seeing the source data at all.

'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

Set sh1 = bk.workbooks("Sheet2")

Quotes!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

Oops! Sorry

Bk.worksheets("Sheets")

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mintjulep]

As a guess:

Set Sh1 = Bk.Worksheets("Sheet2") ' The data source sheet in the source report

 

[SkipVought]

Boy, I had a hard time trying to get it right; and along comes mintjulep! ;-)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mintjulep]

You had it earlier Skip, but you didn't believe in yourself.

 

[Walter349]

Thanks all, I cannot believe I could not see that. Talk about being as thick as a short plank.

It works fine now with the 'Ah Hem!' correction.

'If at first you don't succeed, then your hammer is below specifications'

 

[Walter349]

OK, Good news and bad news.

The good news.

The script works when getting data from a normal spreadsheet, no problem.

The Bad news.

It does not take the data from the source workbook sheets that I am trying to get the data from. The sheets are not protected at all. But they do have some code behind them to make them function in a certain manner. This may be the problem. The files are in XLS format, is there VBA script that would allow me to go through the lot (En Masse) and save them in xls format but without the code behind them. Maintaining the original filename would not be important, but each should be unique of course. Oh and each workbook sheet needed has its tab named to match an ID number in a cell on the sheet. I am not sure if that is having an effect on this. Its name in the object properties is still sheet2.

'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

Seems as if you have workbooks that run code in the Workbook_Open event, that is preventing you from doing the scraping that you need in this code.

I like to code my workbooks that run code in the Workbook_Open event, using a delay. You might consider using a technique something like this:
[tt]
1. In the Workbook_Open event run a procedure that will call the MAIN procedure after a delay of say 1 minute.

2. The MAIN procedure also has a LOCKOUT that can prevent the code from executing the stuff you're doing now, like...

sub Main
   if Not [Lockout] then
      'run your code here
   end if
end sub

Set you Lockout to FALSE so that on any normal open, the code will run after the delay period.

3. when the code in this thread opens the workbook, the FIRST thing you do is assign [Lockout].Value = TRUE. This prevents the code from running.
[/tt]
Another possibility is to use MS Query to access these workbooks to grab the data you need.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[PHV]

You may try this before opening the workbooks:
Application.AutomationSecurity = 3 '3=msoAutomationSecurityForceDisable

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Walter349]

Skip,

Thanks for that. I shall look at the code in the template for future use. At the moment I have 50,000+ records to go through, so its not something I can do retrospectively. I am trying to consolidate key information from the workbooks to make look up and analysis easier.

PHV.
I shall give this try today and advise the results.

Many thanks to all of you for your help on this.

'If at first you don't succeed, then your hammer is below specifications'

 

[Walter349]

PHV

I tried your suggestion, It is still not bringing the data in, it was applied as below.

Sub importFPRptData()

Dim X As Long, Z As Variant, Y As Variant
Dim Bk As Workbook, Sh As Worksheet, Sh1 As Worksheet
Dim rng As Range
Dim rng1 As Range

Set Sh = Workbooks("FP Report.xlsm").Worksheets("Data") 'Destination

Application.ScreenUpdating = False

Application.AutomationSecurity = 3 '3=msoAutomationSecurityForceDisable

'Get the fields to be used for extracting data.

Z = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
If Not IsArray(Z) Then
    MsgBox "Nothing was selected"
    Exit Sub
End If

For X = 1 To UBound(Z)

    Set Bk = Workbooks.Open(Z(X))

'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

Not bringing data in"

When you step thru the code, what do you observe?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Walter349]

Sorry to have taken so long to get back on this. Its been a bit busy.

So once again stepping through.

It opens the folder dialog.
Accepts the selected workbook
Opens the selected workbook
passes though all instances of SH1 copy/paste but without populating it at all. (I put a watch on all variables to check)
Then completes by closing the selected workbook and indicating 'Data import completed'

Only problem is it is not collecting the data from the source workbook as far as I can see.

If I put sample data at the expected sheet/cell locations on a plain test workbook(no VBA code behind it), and select that, it copies the requested data from the source cell/sheet without any problem. So my thinking on this is, that the code behind the source workbooks that I want to use, is causing the problem in some way.


'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

Rather than copy 'n' paste, assign the values like

Sh.cells(whatever).value = sh1.range(other).value

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Walter349]

Skip,

No Luck, still not picking up the source data from the workbook. It opens it alright, as I can watch it go into the VBA behind the source workbook. But it just will not get the data from the source cells in the worksheet.

Frankly, I am having to put this on the back burner now. I just don't have the time at the moment.

Many thanks for the help

'If at first you don't succeed, then your hammer is below specifications'