CODEWITHSUNDEEP
vbaexcel
pottec92
pottec92

Reputation: 23

Looping through cells in another workbook to copy specific values

I've been fighting with this for a couple days now, and am at a loss on what else to try. My goal is to have a prompt for where a workbook is saved, this spreadsheet is obtained from an external source and name/location can vary. After opening the workbook, switch over to the second sheet and start searching for the values to copy to the workbook the macro is run out of.

The code I have works great if I set a breakpoint at the calculation for the last row, and at the For loop. Without those 2 breakpoints, it appears that none of the information in the workbook loads before running the rest of the code.

Public Sub Clm2Count()
Dim i, j, k, last As Long
Dim wkbSource, wkbCrnt As Workbook
Dim str As Variant
Dim strArray()
strArray() = Array("THIS", "IS", "MY", "ARRAY")
Set wkbCrnt = ThisWorkbook

k = 1

With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Application.ScreenUpdating = False
        Set wkbSource = Workbooks.Open(.SelectedItems(1))
        Application.ScreenUpdating = True
    End If
End With

Sheets(2).Activate
Cells(5,1).Select 'Trying to activate a cell before calculating last, didn't work

last = wkbSource.Sheets(2).Cells(wkbSource.Sheets(2).Cells.Rows.Count, 1).End(xlUp).Row

For i = 51 To last
    If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Value, "TEST") > 0 Then
        For Each str In strArray
            If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, str, vbTextCompare) > 0 Then
                If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, "A", vbTextCompare) > 0 Or InStr(1, Cells(i, 2).Text, "B", vbTextCompare) > 0 Then
                    If str = "MY" Then 'Specific value from the array
                        wkbSource.Sheets(2).Cells(i, 3).Copy
                        wkbCrnt.Sheets(1).Cells(k, 1).PasteSpecial
                        wkbCrnt.Sheets(1).Cells(k, 2).Value = "QC"
                        wkbCrnt.Sheets(1).Cells(k, 3).Value = i & ", " & str
                        k = k + 1
                        Exit For
                    End If
                ElseIf InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, "C", vbTextCompare) > 0 Then
                    wkbSource.Sheets(2).Cells(i, 3).Copy
                    wkbCrnt.Sheets(1).Cells(k, 1).PasteSpecial
                    wkbCrnt.Sheets(1).Cells(k, 2).Value = "QC"
                    wkbCrnt.Sheets(1).Cells(k, 3).Value = i & ", " & str
                    k = k + 1
                    Exit For
                Else
                    Exit For
                End If
            End If
        Next str
        wkbSource.Activate
    End If
Next i
End Sub

Any ideas on what I might be overlooking?

Edit: Here are images of the beginning and end of column A, with the identifiers removed Beginning End

Upvotes: 2

Views: 443

Answers (1)

Pawel Czyz
Pawel Czyz

Reputation: 1645

Instead of Sheets(2).Activate use wkbSource.Sheets(2).Activate. Same goes for cells and any other kind of ranges you are using.

It is especially crucial to be as explicit as possible which is the target workbook when you have a multiple workbook interaction.

To find last row use this line:

last = wkbSource.Sheets(2).Cells(wkbSource.Sheets(2).Cells.Rows.Count, 1).End(xlUp).Row

Edit: The issue was caused by a hidden sheet - it is better to use sheets name in this case.

Upvotes: 1

Related Questions