2
votes

I have run through the relevant topics on the Internet, however I cannot find a solution to the problem I have encountered. I am working on a macro which would copy relevant data from one workbook into a newly created sheet in another workbook and then loop through the remaining worksheets of the latter to find exact matches to the data in this newly created sheet. The part in which I copy and paste the data works fine, however, when it comes to looping through worksheets an error occurs.

I worked up multiple versions of this macro to see whether different solutions would work, however, actually none seems to work. I the destination workbook, the worksheet contain data tickers (sort of an id) in column A, the measure of data relevance in column B and names of the variables in column C.

What I am trying to do is, after copying and pasting the data to a newly created sheet - where the data tickers are contained in column L, loop through all the default sheets in the destination workbook to check whether the tickers in column L of the newly created sheet overlap with the tickers in column A of the remainig worksheets, and, if so, copy the variable name from column C of the relevant worksheet into the newly created worksheet column M. The newly created worksheet is called "Settings" and contains headers in row 1 (it also consists of about 110 rows), the remaining worksheets contain no headers (and have 70 rows maximum).

The macro looks like this:

Sub match1()

    Dim listwb As Workbook, mainwb As Workbook
    Dim FolderPath As String
    Dim fname As String
    Dim sht As Worksheet
    Dim ws As Worksheet, oput As Worksheet
    Dim oldRow As Integer
    Dim Rng As Range
    Dim ws2Row As Long

    Set mainwb = Application.ThisWorkbook
    With mainwb
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Settings"
        Set oput = Sheets("Settings")
    End With

    FolderPath = "C:\VBA\"

    fname = Dir(FolderPath & "spr.xlsx")


    With Application
        Set listwb = .Workbooks.Open(FolderPath & fname)
    End With

    Set sht = listwb.Worksheets(1)

    With sht
        .UsedRange.Copy
    End With

    mainwb.Activate

            With oput
                .Range("A1").PasteSpecial
            End With

            For Each ws In ActiveWorkbook.Worksheets
                If ws.Name <> "Settings" Then
                    ws2Row = ws.Range("A" & Rows.Count).End(xlUp).Row
                    Set Rng = ws.Range("A:C" & ws2Row)
                    For oldRow = 2 To 110
                        Worksheets("Settings").Cells(oldRow, 13) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(Worksheets("Settings").Cells(oldRow, 12), Rng, 3, False), "")
                    Next oldRow
                End If
            Next ws

End Sub

Alternative version looks like this (skipping the copy-paste part):

 mainwb.Activate

        With oput
            .Range("A1").PasteSpecial
        End With

        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "Settings" Then
                i = 1
                For oldRow = 2 To 110
                    For newRow = 1 To 70
                        If StrComp((Worksheets("Settings").Cells(oldRow, 12).Text), (ws.Cells(newRow, 1).Text), vbTextCompare) <> 0 Then
                            i = oldRow
                            Worksheets("Settings").Cells(i, 13) = " "
                            Else
                            Worksheets("Settings").Cells(i, 13) = ws.Cells(newRow, 3)
                            i = i + 1
                            Exit For
                        End If
                    Next newRow
                Next oldRow
            End If
        Next ws

When I launch the first version of the macro I get an error:

Run-time error '1004':

Method 'Range' of object '_Worksheet' failed

Debugging highlights the part:

Set Rng = ws.Range("A:C" & ws2Row)

When I run the second version of the macro the error message reads:

Run-time error '9':

Subscript out of range

Debugging highlights the part:

If StrComp((Worksheets("Settings").Cells(oldRow, 12).Text), (ws.Cells(newRow, 1).Text), vbTextCompare) <> 0 Then

I suspect the problem is the definition and use of the ws (Worksheet) object. I am confused now because I use VBA a lot and I've done tasks much harder than this one. And yet I still can't solve the problem. Could you please suggest some solution. I will appreciate your help.

1
With the first version try Set Rng= ws.Range("A1","C" & ws2Row)MGP
Anotherthing: When you want to overwrite the value of a cell you need to use .Value so in your case it should look like this: Worksheets("Settings").Cells(i, 13).Value = " " and Worksheets("Settings").Cells(i, 13).Value = ws.Cells(newRow, 3).Value. Same logic, is the reason for the error in the alternative code, there try: If StrComp((Worksheets("Settings").Cells(oldRow, 12).Value), (ws.Cells(newRow, 1).Value), vbTextCompare) <> 0 ThenMGP
Correct me if I am wrong but there seems to be no range in UsedRange sht. Always use mybaseworkbook.sheets(1).range(any).command and mywbtocopyfrom.sheets(1).range(any).command it is far more easier to manage then and can solve many issues with activation of workbooksLance
Thank you for your hints. However, lack of .Value is of no consequence in this situation. Even if I add .Value to the code, I get the same errors as previously. Could you suggest some modification to the loop so that the ws object would be supported?Jane Doe
Lance, thank you for your answer. However, this is actualy fine. UsedRange doesn't actually need further definitions. The problem starts with the loop over the destination workbook.Jane Doe

1 Answers

0
votes

In this line: Set Rng = ws.Range("A:C" & ws2Row) you do not indicate a row value for Column A. Your code basically says Range("A:C110"), which doesn't really mean anything to Excel. Try changing it to Range("A2:C" & ws2Row).

Does that fix the problem?