Activating Workbooks problem

[mscantle]

I am having problems activating a workbook inside a for - next loop. The first time the loop executes, all works fine. However, subsequent passes through it leave the ThisWorkbook as the active workbook, despite the code including an explicit line to activate the external workbook in question.

The code is very long and convoluted, but goes something like this:

pasteNewRow = 10
For i = 1 to 100
Workbooks(updtFileName).Activate
ActiveWorkbook.Worksheets(subjSheetName).Rows(i).Select
Selection.Copy
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Data").Range("A" & pasteNewRow).Select
ActiveSheet.Paste
pasteNewRow = pasteNewRow + 1
Next i

The first time through, it copies row i from workbook called updtFileName, then goes to ThisWorkbook and pastes into row pasteNewRow.

The subsequent times through, the active workbook remains as ThisWorkbook, even though the line Workbooks(updtFileName).Activate is present.

How can it possibly ignore the activate command?

I have tried putting in a MsgBox to reveal the name of the active workbook, and this confirms that it is ThisWorkbook.

The only unusual thing is that I get the name of the external updtFileName by prompting the user to browse for it using updtFileName = Application.GetOpenFilename

Any ideas?

Matt

 

[Jonmo1]

You write the code in such a way that it does not matter which book is currently active....

Try

pasteNewRow = 10
For i = 1 to 100
 
    Workbooks(updtFileName).Worksheets(subjSheetName).Rows(i).Copy
    ThisWorkbook.Worksheets("Data").Range("A" & pasteNewRow).PasteSpecial xlPasteAll
    pasteNewRow = pasteNewRow + 1
Next i

Hope that helps.

 

[JoeMo]

Why not paste all the rows in one shot?

pasteNewRow = 10
Workbooks(updtFileName).Worksheets(subjSheetName).Rows("1:100").Copy
ThisWorkbook.Worksheets("Data").Range("A" & pasteNewRow).PasteSpecial xlPasteAll

 

[mscantle]

Thanks Jonmo1,

I gave that a try but it doesn't increment from row to row in the updtFileName workbook - I just get multiple copies of the first row it copied.

Any further thoughts?

Also, why doesn't my activate work - is there a reason?

 

[mscantle]

Maybe there's something I've missed in the rest of the code? See below:

Sub Update()
Range("A4:ZZ9999").Select
    
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("A4:A9999"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("A4:ZZ9999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Dim numOriginalUsedRows As Long
    Range("A1").Select
    On Error Resume Next
    numOriginalUsedRows = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    'MsgBox ("numOriginalUsedRows = " & numOriginalUsedRows)
    
    'get name of current workbook
curWorkbook = ActiveWorkbook.Name
'MsgBox ("curWorkbook = " & curWorkbook)
    
'prompt for update file name from which to import
updtFileName = Application.GetOpenFilename
'prompt for subject sheet name from which to import
subjSheetName = InputBox(Prompt:="Which Subject Worksheet?", _
          Title:="Subject Worksheet Selector", Default:="")
'read first upn from current file
    
    'start looking for upns from row 3 up to last used row
    For i = 4 To numOriginalUsedRows
    
        Worksheets("Data").Activate
        Range("A" & i).Select
        upnNum = ActiveCell.Value
       ' MsgBox "UPN = " & upnNum
        If upnNum <> "" Then
        
'look for upn in target file
Workbooks.Open Filename:=updtFileName
getTgtFileName = ActiveWorkbook.Name
'MsgBox ("Name of target file is " & getTgtFileName)
Worksheets(subjSheetName).Activate
Range("A3:ZZ9999").Select
    
    ActiveWorkbook.Worksheets(subjSheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(subjSheetName).Sort.SortFields.Add Key:=Range("A4:A9999"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(subjSheetName).Sort
        .SetRange Range("A4:ZZ9999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'find number of used rows
    Dim numTgtUsedRows As Long
    Range("A1").Select
    On Error Resume Next
    numTgtUsedRows = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    'MsgBox ("The number of rows in target = " & numTgtUsedRows)
    
    'start looking for upns from row 3 up to last used row
    For j = 3 To numTgtUsedRows
    
        Range("A" & j).Select
        tgtUpnNum = ActiveCell.Value
        'MsgBox ("tgtUpnNum = " & tgtUpnNum & " j = " & j)
        
        
        
        If tgtUpnNum = upnNum Then
        
        MsgBox ("Match for UPN = " & tgtUpnNum)
        
        Workbooks(getTgtFileName).Worksheets(subjSheetName).Activate
        Workbooks(getTgtFileName).Worksheets(subjSheetName).Range("A" & j & ":AG" & j).Select
        'MsgBox "Selected"
        Selection.Copy
        
        'MsgBox "Copied"
        Application.DisplayAlerts = False
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
        
        
        Workbooks(curWorkbook).Worksheets("Data").Activate
        
        'MsgBox "Selected"
        Workbooks(curWorkbook).Worksheets("Data").Range("A" & i & ":AG" & i).Select
        Workbooks(curWorkbook).Worksheets("Data").Paste
    
        
       Workbooks(updtFileName).Worksheets(subjSheetName).Activate
       
       
        GoTo a:
        
        End If
        
    
    Next j
    'MsgBox ("No match for UPN = " & upnNum)
    'MsgBox ("Entering loop. moveUsedRows = " & moveUsedRows)
Application.DisplayAlerts = False
        Workbooks(getTgtFileName).Close SaveChanges:=False
        Application.DisplayAlerts = True

ThisWorkbook.Worksheets("Archive").Activate
'MsgBox ("Active sheet = " & ActiveSheet.Name)
ThisWorkbook.Worksheets("Archive").Range("A1").Select

'MsgBox ("Selected")
    On Error Resume Next
    moveUsedRows = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    moveUsedRows = moveUsedRows + 1
    'MsgBox ("moveUsedRows = " & moveUsedRows)
    
    
ThisWorkbook.Worksheets("Data").Activate
'MsgBox ("Active sheet = " & ActiveSheet.Name)
    ThisWorkbook.Worksheets("Data").Rows(i).Select
    Selection.Cut
    
ThisWorkbook.Worksheets("Archive").Activate
'MsgBox ("Active sheet = " & ActiveSheet.Name)
 
    ' MsgBox ("moveUsedRows = " & moveUsedRows)
    ThisWorkbook.Worksheets("Archive").Range("A" & moveUsedRows).Select
    'MsgBox ("Selected")
    ActiveSheet.Paste
   ' MsgBox ("Pasted")
    
'do next upn
End If
a:
'MsgBox "active workbook is " & ActiveWorkbook.Name
If ActiveWorkbook.Name = getTgtFileName Then
'MsgBox "active workbook is now " & ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End If
Workbooks(curWorkbook).Worksheets("Data").Activate
Next i
'Order by UPN
ThisWorkbook.Worksheets("Data").Activate
Range("A4:ZZ9999").Select
    
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("A4:A9999"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("A4:ZZ9999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'*********************
'DEV FROM HERE
'*********************
'Get used rows in workbook1 to be updated = numUsedRowsWB1
Dim numUsedRowsWB1 As Long
    ThisWorkbook.Worksheets("Data").Range("A1").Select
    On Error Resume Next
    numUsedRowsWB1 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    MsgBox ("The number of rows in WB1 = " & numUsedRowsWB1)
'Get used rows in workbook2 to update from = numUsedRowsWB2
Dim numUsedRowsWB2 As Long
Workbooks.Open Filename:=updtFileName
Workbooks(updtFileName).Worksheets(subjSheetName).Range("A1").Select
    On Error Resume Next
    numUsedRowsWB2 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    MsgBox ("The number of rows in WB2 = " & numUsedRowsWB2)

pasteNewRow = 1000
For l = 3 To numUsedRowsWB2
    UpnNumWB2 = Worksheets(subjSheetName).Cells(l, 1).Value
    MsgBox ("UpnNumWB2 = " & UpnNumWB2)
    
    For k = 4 To numUsedRowsWB1
    
        UpnNumWB1 = ThisWorkbook.Worksheets("Data").Cells(k, 1).Value
        MsgBox ("UpnNumWB1 = " & UpnNumWB1)
        If UpnNumWB1 = UpnNumWB2 Then
            
            MsgBox ("Match")
            GoTo Skip
            
        End If
            
    Next k
    MsgBox ("No match")
    Workbooks(updtFileName).Activate
    MsgBox ("1: Activated: " & ActiveWorkbook.Name & " l = " & l)
    ActiveWorkbook.Worksheets(subjSheetName).Rows(l).Select
    MsgBox ("2: Selected")
    Selection.Copy
    MsgBox ("3: Copied")
    ThisWorkbook.Activate
    MsgBox ("4: Activated")
    ThisWorkbook.Worksheets("Data").Range("A" & pasteNewRow).Select
    MsgBox ("5: Selected")
    ActiveSheet.Paste
    MsgBox ("6: Pasted")
    pasteNewRow = pasteNewRow + 1
    
    
    
'    MsgBox ("No match. l = " & l)
'    Workbooks(updtFileName).Worksheets(subjSheetName).Rows(l).Copy
'    MsgBox ("1: Copied")
'    ThisWorkbook.Worksheets("Data").Range("A" & pasteNewRow).PasteSpecial xlPasteAll
'    MsgBox ("2: Pasted")
'    pasteNewRow = pasteNewRow + 1
    
   
Skip:
MsgBox ("Skipping")
Next l
 
End Sub