Question

i am a new coder. Just a beginner in vba, and would like some help to solve this. i know i can use normal excel formulas but this is for learning. here is my code so far:

Sub matchpart()
Dim ocell As Range
Dim swb As Workbook
Dim sws As Worksheet, dws As Worksheet
Dim stext As String
Dim iRow As Long
Dim nxtRow As Long


Set swb = ActiveWorkbook
Set sws = swb.Sheets("sheet1")
Set dws = swb.Sheets("sheet2")

For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
On Error Resume Next
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0)
On Error GoTo 0
    If iRow > 0 Then
       Application.Index (Range("ID_PARENT").Copy)
    Else
        ocell.Offset(0, 1) = ""
        End If
        Next

MsgBox ("Done")
End Sub

my task is to match 1 column from sheet 2 (ID_NUMBER) with 1 column sheet 1 (FILE_NAMES). after this copy the corresponding value in the next column in sheet 1 (which has been matched) and paste it into the next column in sheet 2.

here is my data as an e.g sheet1:

ID_PARENT     ID_NUMBER 
pan               3
same              2
kappa             1
lame              5
dame              5

sheet 2:

FILE_NAMES      BPM_LIST
1                   
5
3
2
4
5

thus would like to match and copy in to BPM_LIST using my code.

Answer 1

Don't use Application.WorksheetFunction.Match(...) ; use Application.Match(...) and pass the return value back to a variant. This will allow you to check with IsError(...).

Additionally, (just like using MATCH on a worksheet), you cannot locate a number using text-that-looks-like-a-number; e.g. 1 <> "1". I don't know what your data is actually like (true number or text-that-look-like-numbers) but you may have to use Int(stext) instead of stext in the Match.

dim iRow  as variant
For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
    iRow = Application.Match(stext, sws.Range("ID_NUMBER"), 0)
    If IsError(iRow) Then
        ocell.Offset(0, 1) = vbnullstring
    Else
       ocell.Offset(0, 1) = Range("ID_PARENT").Cells(lRow, 1).Value
    End If
Next ocell

Answer 2

HI sorry for taking your time. i found my solution to my problem. it was just to use an index function as i had already got the row numbers which were matched i.e iRow.

Sub matchpart()
Dim ocell As Range
Dim ocells As Range
Dim swb As Workbook
Dim sws As Worksheet, dws As Worksheet
Dim stext As String
Dim iRow As Long
Dim nxtRow As Long


Set swb = ActiveWorkbook
Set sws = swb.Sheets("sheet1")
Set dws = swb.Sheets("sheet2")

For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
On Error Resume Next
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0)
On Error GoTo 0
    If iRow > 0 Then
       ocell.Offset(0, 1) = WorksheetFunction.Index(sws.Range("ID_PARENT"), iRow, 0)

    Else
        ocell.Offset(0, 1) = ""
        End If
        Next

MsgBox ("Done")
End Sub

thanks for the help anyways :)

Answer 3

You wanted code to study and learn. Here it is. I didn't pay much attention to whether it also does what you want because I think you can tweak my code in the direction you would like it to bend. Have fun!

Sub matchpart()
    ' 10 Apr 2017

    Dim Wb As Workbook
    Dim WsSrc As Worksheet                  ' Identify the sheet as Source
    Dim WsTgt As Worksheet                  ' Identify the sheet as Target
    Dim sText As String
    Dim R As Long, lastRow As Long          ' last row in WsTgt
    Dim iRow As Long                        ' why do you call "Found row" iRow?

    Set Wb = ActiveWorkbook                 ' actually, this is the default
    With Wb                                 ' declaring it just reminds you of the fact
        Set WsSrc = .Sheets("IDs")
        Set WsTgt = .Sheets("File Names")   ' I used my own names for testing
    End With

    With WsTgt
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' most programmers prefer to call the columns by their numbers
        ' instead of their names (like "A") as I have done here.
        ' VBA must convert the names to numbers.
        ' Therefore using numbers to begin with is faster.
        ' You can change all names to numbers in this code
        ' Just replace "A" with 1, "B" with 2 etc.

        For R = 2 To lastRow                ' omit row 1 (captions)
            sText = .Cells(R, "A").Value    ' can't use partial with MATCH function
            On Error Resume Next
            iRow = WorksheetFunction.Match(sText, WsSrc.Columns("B"), 0)
            If Err.Number = 0 Then
                .Cells(R, "B").Value = WsSrc.Cells(iRow, "A").Value
            End If
            Err.Clear
        Next R
    End With

    MsgBox ("Done")
End Sub

The point where my code diverts from your intention is that you wanted a "partial match". That can't be achieved using the MATCH worksheet function. You would need to use VBA's Find for that. But that might better be another lesson on another day, lol:

Copy data Using Vba, Match function

3 个答案: