Inconsistant Macro

[PeterTaylor]

Dear All,
I am using excel 2007 and vista 64 bit.
I have the follow macro that steps thru a list of excel files appends the first 14 columns of data to a master files then searchs thru the added file adding the data in named columns to the equilvaent columns in the master column ( the column names in each added file are translated to master file coumn names in the master file.

Sub copy_to_master_collar()
    Application.DisplayAlerts = False
    'Application.ScreenUpdating = False
    
    Workbooks.Open Filename:="K:\collars\1AAA_AL_COLLARS.xlsm"
    Workbooks.Open Filename:="K:\Collar_import_log_file.xlsm"
    
    Dim bCol As Integer, myTest As String, strName As String, myTotalRows As Integer, myTotalColumns As Integer, _
        myColumn As Integer, MyRow As Integer, MyRange As Range, mylist As String, myFilename As String, _
        aRow As Integer, TestBlank As Integer, zRow As Integer, _
        ZCol As Integer, myWindowname As String, xRow As Integer, xCol As Integer, myTotalCollarRows As Integer
        
  '**************************
   
            aRow = 2
            zRow = 1
            ZCol = 1
            xRow = 1
            xCol = 1
        Sheets("imports").Select
    ' Start loop
Do
'On Error GoTo 0
    ' Define values to mylist and myFilename for current pass of Do - Loop cycle
        mylist = Cells(aRow, 1).Value
        myFilename = Cells(aRow, 2).Value
        myWindowname = Cells(aRow, 3).Value
    ' check length of current mylist value,for a zero length
        If Len(mylist) = 0 Then
            ' in case of stray blanks in unsorted data, check next 10 rows
                If TestBlank < 10 Then
                    TestBlank = TestBlank + 1
                    ' kick back to loop start
                     GoTo NoError:
        Else
            MsgBox "End of File Encountered The Procedure will now exit"
                'ActiveWorkbook.Save
                'ActiveWorkbook.Close
                Windows("1AAA_AL_COLLARS.xlsm").Activate
                'ActiveWorkbook.Save
                'ActiveWorkbook.Close
            Application.DisplayAlerts = True
            'Application.ScreenUpdating = True
Exit Do

                End If
        End If
        ' a valid entry needed to get here so reset testblank to 0
        TestBlank = 0
        ' for a non zero length value of mylist, report current value to user and attempt to open file
  '************************
                
        Workbooks.Open mylist
        myTotalRows = ActiveSheet.UsedRange.Rows.Count
        myTotalColumns = ActiveSheet.UsedRange.Columns.Count
        'Test if the last row has drill hole data
        
        If Len(Cells(myTotalRows, 16)) = 0 Then
            Rows(myTotalRows).Select
            Selection.Delete Shift:=xlUp
            myTotalRows = myTotalRows - 1
        'Else
            'GoTo Point A
        End If
'Point A:
        'Copy the fist 14 colunms of data to main file
        Range(Cells(2, 1), Cells(myTotalRows, 14)).Select
        Selection.Copy
        Windows("1AAA_AL_COLLARS.xlsm").Activate
        myTotalCollarRows = ActiveSheet.UsedRange.Rows.Count
        myTotalCollarRows = myTotalCollarRows + 1
        'Cells(1, 2).Select
        'Selection.End(xlDown).Select
        
        'MyRow = ActiveCell.Row + 1
        Cells(myTotalCollarRows, 2).Select
        ActiveSheet.Paste
        
        ' copy the rest of the data colunm by colunm to main file
        
        Windows(myWindowname).Activate
        
           bCol = 15
        ' set to run while row 1 not blank
    While Len(Cells(1, bCol)) > 0
        Cells(1, bCol).Select
        myTest = Trim(UCase(ActiveCell.Value))
        
On Error GoTo NomatchSkip1
        'strName = ""
        
        strName = WorksheetFunction.VLookup(myTest, _
                  Workbooks("Collar_import_log_file.xlsm").Worksheets("Lookup").Range("A1:B1368"), 2, False)
        Range(Cells(2, bCol), Cells(myTotalRows, bCol)).Select
        Selection.Copy
        Windows("1AAA_AL_COLLARS.xlsm").Activate
        'Set MyRange = Worksheets("Sheet1").Names(strName).RefersToRange
        Range(strName).Select
        Selection.End(xlDown).Select
        'MyRow = ActiveCell.Row + 1
        myColumn = ActiveCell.Column
        Cells(myTotalCollarRows, myColumn).Select
        ActiveSheet.Paste
        GoTo point1
        'bCol = bCol + 1
        'Windows("1.xlsx").Activate
NomatchSkip1:
Resume point1
point1:
        bCol = bCol + 1
       Windows(myWindowname).Activate
Wend
        ' on exit bCol set ready for the next file
            bCol = 15
           Windows(myWindowname).Activate
           ActiveWorkbook.Close
           Windows("Collar_import_log_file").Activate
           aRow = aRow + 1
           Sheets("Clean imports").Select
           Cells(zRow, 1).Value = mylist
           myTotalRows = myTotalRows - 1
           Cells(zRow, 2).Value = myTotalRows
           zRow = zRow + 1
           Sheets("imports").Select
NoError:
Loop
    
End Sub

There ~2700 files to add to the master file; the macro works fine when I step thru using debug but when I run the macro not only about 10% of the data is appended.
It appears that the macro does not completely the executed each line before moving on to the next. Is there a way to stop this?
Regards
Peter

 

[mole999]

http://www.mrexcel.com/forum/showthread.php?t=36052

might help

 

[Norie]

Peter

I think the problem could be that you aren't fully qualifying some references.

For example here, without workbooks/worksheet referencs then VBA will think you mean Cells on what it considers the active worksheet/workbook.

Range(Cells(2, 1), Cells(myTotalRows, 14)).Select
        Selection.Copy

I'm not sure how to fix this because you don't seem to mention the worksheet the data is coming from by name or index.

You do use ActiveSheeet which could actually be in any workbook.

One thing that might get you started is to create referencs to each workbook you open, when you open them.

Something like this.

Dim wbCollars As Workbook
Dim wbImport As Workbook
Dim wsImports As Worksheet
 
    Application.DisplayAlerts = False
 
    Set wbCollars = Workbooks.Open(Filename:="K:\collars\1AAA_AL_COLLARS.xlsm")
    Set wbImport = Workbooks.Open(Filename:="K:\Collar_import_log_file.xlsm")
    Set wsImports = wbImport.Sheets("imports")
 
    '**************************
    aRow = 2
    zRow = 1
    ZCol = 1
    xRow = 1
    xCol = 1
 
    ' Start loop
    Do
        With wsImports
            mylist = .Cells(aRow, 1).Value
            myFilename = .Cells(aRow, 2).Value
            myWindowname = .Cells(aRow, 3).Value
        End With

I've only posted that small chunk of code because one other problem of not using references is that it makes the code kind of hard to follow.

 

[PeterTaylor]

Dear Norrie,
The worksheet that the data is coming are listed in "K:\Collar_import_log_file.xlsm" the macro steps thru that sheet putting the worksheet name to the "myList" variable.
Since I open the "myList" immediately prior to using the "activeSheet" command my understanding is that excel will not be confused. I am new to vba so I would welcome another approach.
another thing that confuses me is the macro steps thru several iterations without a problem but will run on auto?
very strange!
Regards
Peter

 

[Norie]

Peter

It's much better to explicitly reference workbooks/worksheets etc rather than relying on something like ActiveSheet.

ActiveSheet might not be what you want/think, it could even be in another workbook.

Anyway, back to the code.

I'm still a bit confused, what are in columns A, B and C on the Imports sheet?

You say that mylist is the worksheet name, but then you say you 'open' mylist?

Is it actually the workbook name, that seems to be how it's being used here.

Workbooks.Open mylist

If it is the workbook you should open it like this.

Set wbOpen = Workbooks.Open(mylist)

That opens the workbook and creates a reference to it, wbOpen.

You can use that reference later in the code, for example.

Set wbOpen = Workbooks.Open(mylist)
 
Set wsData = wbOpen.ActiveSheet 
 
 myTotalRows = wsData.UsedRange.Rows.Count

 myTotalColumns = wsData.UsedRange.Columns.Count

I've used the workbook reference with ActiveSheet, so it will refer to a worksheet in the workbook open.

I would stil recommend you replace ActiveSheet with either Worksheets("SheetName") or Worksheets(1).

The latter would work if ther is only one worksheet in the file you've opened.

 

[PeterTaylor]

Thanks Norrie,
I have to go now; I will implement suggestion and get back to you tomorrow with results
Peter

 

[PeterTaylor]

I have tried to modify the macro so:

Sub copy_to_master_collar()
'
'
Dim wbCollars As Workbook
Dim wbImport As Workbook
Dim wsImports As Worksheet
Dim wsCollars As Worksheet

 
    Set wbCollars = Workbooks.Open(Filename:="K:\collars\1AAA_AL_COLLARS.xlsm")
    Set wbImport = Workbooks.Open(Filename:="K:\Collar_import_log_file.xlsm")
    'Set wsImports = wbImport.Worksheets("test")
    Set wsCollars = wbCollars.Worksheets("Sheet1")
    Set wsImports = wbImport.Sheets("imports")

Dim wbOpen As Workbook
Dim wsData As Worksheet


'
    Application.DisplayAlerts = False
    'Application.ScreenUpdating = False
    
    'Workbooks.Open Filename:="K:\collars\1AAA_AL_COLLARS.xlsm"
    'Workbooks.Open Filename:="K:\Collar_import_log_file.xlsm"
    
    Dim bCol As Integer, myTest As String, strName As String, myTotalRows As Integer, myTotalColumns As Integer, _
        myColumn As Integer, MyRow As Integer, MyRange As Range, mylist As String, myFilename As String, _
        aRow As Integer, TestBlank As Integer, zRow As Integer, _
        ZCol As Integer, myWindowname As String, xRow As Integer, xCol As Integer, myTotalCollarRows As Integer
        
  '**************************
   
            aRow = 2
            zRow = 1
            ZCol = 1
            xRow = 1
            xCol = 1
        'Sheets("imports").Select
    ' Start loop
Do
'On Error GoTo 0
    ' Define values to mylist and myFilename for current pass of Do - Loop cycle
            With wsImports
            mylist = .Cells(aRow, 1).Value
            myFilename = .Cells(aRow, 2).Value
            myWindowname = .Cells(aRow, 3).Value
        End With
        
        'mylist = Cells(aRow, 1).Value
        'myFilename = Cells(aRow, 2).Value
        'myWindowname = Cells(aRow, 3).Value
    ' check length of current mylist value,for a zero length
        
        If Len(mylist) = 0 Then
            ' in case of stray blanks in unsorted data, check next 10 rows
                If TestBlank < 10 Then
                    TestBlank = TestBlank + 1
                    ' kick back to loop start
                     GoTo NoError:
        Else
            MsgBox "End of File Encountered The Procedure will now exit"
                'ActiveWorkbook.Save
                'ActiveWorkbook.Close
                Windows("1AAA_AL_COLLARS.xlsm").Activate
                'ActiveWorkbook.Save
                'ActiveWorkbook.Close
            Application.DisplayAlerts = True
            'Application.ScreenUpdating = True
Exit Do

                End If
        End If
        
        ' a valid entry needed to get here so reset testblank to 0
        TestBlank = 0
        ' for a non zero length value of mylist, report current value to user and attempt to open file
  
  '************************
                
        Set wbOpen = Workbooks.Open(mylist)
        Set wsData = wbOpen.Worksheets(1)
        myTotalRows = wsData.UsedRange.Rows.Count
        myTotalColumns = wsData.UsedRange.Columns.Count
        'Test if the last row has drill hole data
        
        
        If Len(Cells(myTotalRows, 16)) = 0 Then
            wsData.Rows(myTotalRows).Select
            Selection.Delete Shift:=xlUp
            myTotalRows = myTotalRows - 1
        'Else
            'GoTo Point A
        End If
'Point A:
        'Copy the fist 14 colunms of data to main file
        wsData.Range(Cells(2, 1), Cells(myTotalRows, 14)).Select
        Selection.Copy
        
        'wbCollar.Activate
        myTotalCollarRows = wsCollars.UsedRange.Rows.Count
        myTotalCollarRows = myTotalCollarRows + 1
        'Cells(1, 2).Select
        'Selection.End(xlDown).Select
        Windows("1AAA_AL_COLLARS.xlsm").Activate
        'MyRow = ActiveCell.Row + 1
        wsCollars.Cells(myTotalCollarRows, 2).Select
        wsCollars.Paste
        
        ' copy the rest of the data colunm by colunm to main file
        
        Windows(myWindowname).Activate
        
           bCol = 15
        ' set to run while row 1 not blank
    While Len(Cells(1, bCol)) > 0
        wsData.Cells(1, bCol).Select
        myTest = Trim(UCase(ActiveCell.Value))
        
On Error GoTo NomatchSkip1
        'strName = ""
        
        strName = WorksheetFunction.VLookup(myTest, _
                  Workbooks("Collar_import_log_file.xlsm").Worksheets("Lookup").Range("A1:B1368"), 2, False)
        Range(Cells(2, bCol), Cells(myTotalRows, bCol)).Select
        Selection.Copy
        Windows("1AAA_AL_COLLARS.xlsm").Activate
        'Set MyRange = Worksheets("Sheet1").Names(strName).RefersToRange
        Range(strName).Select
        Selection.End(xlDown).Select
        'MyRow = ActiveCell.Row + 1
        myColumn = ActiveCell.Column
        Cells(myTotalCollarRows, myColumn).Select
        ActiveSheet.Paste
        GoTo point1
        'bCol = bCol + 1
        'Windows("1.xlsx").Activate
NomatchSkip1:
Resume point1
point1:
        bCol = bCol + 1
       Windows(myWindowname).Activate
Wend
        ' on exit bCol set ready for the next file
            bCol = 15
           Windows(myWindowname).Activate
           ActiveWorkbook.Close
           Windows("Collar_import_log_file").Activate
           aRow = aRow + 1
           Sheets("Clean imports").Select
           Cells(zRow, 1).Value = mylist
           myTotalRows = myTotalRows - 1
           Cells(zRow, 2).Value = myTotalRows
           zRow = zRow + 1
           Sheets("imports").Select
NoError:
Loop
    
End Sub

But I am still having trouble with making the references more specific and would appreciate any help you could give. This macro still does not give the desired result.

The three columns in the collars give the source file anme in three different forms so:
<table width="543" border="0" cellpadding="0" cellspacing="0"><col style="width: 157pt;" width="209" span="2"> <col style="width: 94pt;" width="125"> <tbody><tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 157pt;" width="209" height="20">Path</td> <td style="width: 157pt;" width="209">Fullname</td> <td style="width: 94pt;" width="125">Excel File</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt;" height="20">K:\Collars\1.xlsx</td> <td>1.xlsx</td> <td align="right">1</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt;" height="20">K:\Collars\2.xlsx</td> <td>2.xlsx</td> <td align="right">2</td> </tr> </tbody></table>

 

[Norie]

Peter

What problems are you having?

Why is the filename listed in 3 different formats?

You should only need something for the path, something for the filename and something for the worksheet name.

In fact you could just combine the path and file

 

[PeterTaylor]

I have it in three forms because I need to open the source data workbook (eg 1.xlsx) intially to copy the data and then switch to the Collar_import_log_file.xlsm workbook to paste the data then switch back the the data workbook to begin coping some more data column by column and I do not know any other way to do it.

The main problem is that the macro works OK for the first 90 or so iterations then seems to "lose its way". I have counted the records that shoulb copied to the master file (~450,000) but I only have ~45,000 when the process is complete.
Regards
Peter

 

[Norie]

Peter

You shouldn't need to 'switch' between workbooks to copy/paste data

That's the whole idea of creating references to them and other things like worksheets.

All you should need for the workbook you are importing is the path and filename, and you only really need them when you open the workbook.

Once you've opened the workbook and created a reference to it you can use that reference in the rest of the code

Something like this, which would obviously be repeated for each file in some sort of loop.

Dim wbData As String
Dim strPath As String
Dim strFilename As String
 
        strPath ="C:\"
        strFileName = "MyFile.xls"
 
        Set wbData = Workbooks.Open(strPath & strFileName)
 
        ' code to copy data from worbook
 
        ' close workbook once done
 
         wbDatat.Close

The only other thing you would need would be the worksheet name the data is on

By the way, which workbook is the code located in?

I'm sorry for not being more helpful but everytime I look at the code I get lost.

I just can't seem to follow the flow, and I think the main reason for that is because it seems to be jumping about all the time.

That's one of the problems of using things like Goto I'm afraid.