help with vba code to match data on multiple worksheets

kevinh2320

Board Regular
Joined
May 13, 2016
Messages
51
I need help with VBA code that will complete the following tasks:

1. On my “Leases” worksheet find all rows with the word “Yes” in the IN_DEFAULT column (column F) and copy those rows A through J.
example "leases" worksheet
FILE_TYPEFILE_NUMBERCASE_TYPESUB_TYPEOPRIN_DEFAULTSTATUSPAY_DUE_DATEAMT_OWEDADJ_NOTES
ABC123456121351/1/2019
ABC123457121Yes351/1/20191000.00Default
ABC123458121Remove351/1/2019Remove
ABC123459121Yes351/1/20191500.00Default
ABC123410121Question381/1/2019Question
ABC123411121351/1/2019
ABC123412121Yes351/1/2019800.00Default

<tbody>
</tbody>

2. Go to the "InDefaultMerge" worksheet and paste the rows found from the "Leases" worksheet into the first available row at cell "A2"
example "InDefaultMerge" worksheet (phase I)
FILE_TYPEFILE_NUMBERCASE_TYPESUB_TYPEOPRIN_DEFAULTSTATUSPAY_DUE_DATEAMT_OWEDADJ_NOTES
ABC123457121Yes351/1/20191000.00Default
ABC123459121Yes351/1/20191500.00Default
ABC123412121Yes351/1/2019800.00Default

<tbody>
</tbody>

3. Evaluate the first "FILE_NUMBER" cell in the "InDefaultMerge" worksheet and then go to the "CustInfo" worksheet to look for a matching record. If found copy cells (columns D through F) to the match record (row) in the "InDefaultMerge" worksheet.
example CustInfo worksheet
FILE_TYPEFILE_NUMBERCUST_IDCUST_NAMEADDRESSCITY/ST/ZIP
ABC1234561ABC CO123 ANY ST.SEA WA 98022
ABC1234572B&C INC.11 1ST AVESEA WA 98022
ABC1234583DZIP CO.132 22NDSEA WA 98022
ABC1234594BEVCO32 A ST.SEA WA 98022
ABC1234105PRICECO333 22NDSEA WA 98022
ABC1234116DD SHOP55 N. 6THSEA WA 98022
ABC1234127BESTB92 W. MAPLESEA WA 98022
ABC1234138Z COMM44 RAIL ST.SEA WA 98022
ABC1234149TEST CO.73 1ST AVE.SEA WA 98022
ABC12341510BRAND C.111 8TH PL.SEA WA 98022
ABC12341611LEVEL UP421 6TH AVE.SEA WA 98022

<tbody>
</tbody>

4. Desired "InDefaultMerge" worksheet shown below:
FILE_TYPEFILE_NUMBERCASE_TYPESUB_TYPEOPRIN_DEFAULTSTATUSPAY_DUE_DATEAMT_OWEDADJ_NOTESCUST_NAMEADDRESSCITY/ST/ZIP
ABC123457121Yes351/1/20191000.00DefaultB&C INC.11 1ST AVESEA WA 98022
ABC123459121Yes351/1/20191500.00DefaultBEVCO32 A ST.SEA WA 98022
ABC123412121Yes351/1/2019800.00DefaultBESTB92 W. MAPLESEA WA 98022

<tbody>
</tbody>

Thank you for any help you can provide.
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,900
Try:
Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, desWS2 As Worksheet, fnd As Range, rng As Range
    Set srcWS = Sheets("leases")
    Set desWS = Sheets("InDefaultMerge")
    Set desWS2 = Sheets("CustInfo")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With srcWS
        .Range("A1:J" & LastRow).AutoFilter Field:=6, Criteria1:="Yes"
        .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        .Range("A1").AutoFilter
    End With
    For Each rng In desWS.Range("B2", desWS.Range("B" & desWS.Rows.Count).End(xlUp))
        Set fnd = desWS2.Range("B:B").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            fnd.Offset(, 2).Resize(, 3).Copy desWS.Cells(rng.Row, 11)
            
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,095,347
Messages
5,443,925
Members
405,256
Latest member
ukboyme

This Week's Hot Topics

Top