CODEWITHSUNDEEP
vbaexcel
Sockmonster1945
Sockmonster1945

Reputation: 3

Match value in 1st Workbook to a column in the 2nd Workbook, and copy specific cells

I have to match a value in 1st workbook to a column of data in the 2nd workbook, then copy specific cells in 1st workbook and paste it in specific cells (same row as match data) in second workbook.

Here is the code I've come up with so far, but it doesn't work, and returns a run time error 1004: application-defined or object-defined error.

Dim FindNo As String
Dim X As Long, LastRow As Long
Dim FoundCell As Range
Dim FColumn As Integer, FRow As Integer
Dim WB1 As Workbook, SHT1 As Worksheet
Dim WB2 As Workbook, SHT2 As Worksheet

Application.ScreenUpdating = False

    Set WB1 = ThisWorkbook
    Set WB2 = Workbooks.Open("Z:\ISO MTSO DOCUMENTS (New Templates)\Incident & Accident Monitoring (2016 and 2017)\Incident Monitoring 2016 and 2017.xlsx")
    Set SHT1 = WB1.Sheets("F-IMS-11")
    Set SHT2 = WB2.Sheets("2017")

    FindNo = SHT1.Range("Q1").Value
    LastRow = SHT2.Range("C" & Rows.Count).End(xlUp).Row

For X = 3 To LastRow

    If SHT2.Cells(X, "C") = FindNo Then

        FRow = FoundCell.Row
        FColumn = FoundCell.Column

    SHT2.Range(Cells(FColumn + 14, FRow)) = SHT1.Cells(13, 1)
    SHT2.Range(Cells(FColumn + 15, FRow)) = SHT1.Cells(7, 6)
    SHT2.Range(Cells(FColumn + 17, FRow)) = SHT1.Cells(46, 2)
    SHT2.Range(Cells(FColumn + 18, FRow)) = SHT1.Cells(58, 2)
    SHT2.Range(Cells(FColumn + 19, FRow)) = SHT1.Cells(58, 13)

    End If

    Application.CutCopyMode = False

Next X

SHT2.Columns(17).WrapText = True
SHT2.Columns(20).WrapText = True
SHT2.Columns(21).WrapText = True

WB2.Save
WB2.Close

Application.ScreenUpdating = True

It would great to hear suggestions, as I don't really have a good background in VBA, and I just tried to modify most of the codes.

Upvotes: 0

Views: 100

Answers (2)

user3598756
user3598756

Reputation: 29421

you're not setting FoundCell before exploiting it, so you should add some Set FoundCell = SHT2.Cells(X, "C") right after If SHT2.Cells(X, "C") = FindNo Then. But it's a waste of crossed references since you already know that matched cell row and column indexes are, respectively X and 3.

furthermore you may want to adopt With-End With syntax to reference an object (a workbook, a worksheet a range...) and access its methods or properties by means of a simple dot (.). this will give you more control over proper object referencing and relieve you from many variables declaring and using.

finally you should avoid repeating access to the same objects within a loop when those objects doesn't change

for all what above you could consider the following refactoring

Option Explicit

Sub main()
    Dim FindNo As String
    Dim X As Long
    Dim val1 As Variant, val2 As Variant, val3 As Variant, val4 As Variant, val5 As Variant

    Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("F-IMS-11") '<--| reference Worksheet object directly from "WB1" workbook
        FindNo = .Range("Q1").Value
        val1 = .cells(13, 1)
        val2 = .cells(7, 6)
        val3 = .cells(46, 2)
        val4 = .cells(58, 2)
        val5 = .cells(58, 13)
    End With

    With Workbooks.Open("Z:\ISO MTSO DOCUMENTS (New Templates)\Incident & Accident Monitoring (2016 and 2017)\Incident Monitoring 2016 and 2017.xlsx") '<--| open and reference wanted "WB2" workbook
        With .Sheets("2017") '<--| reference its "2017" worksheet
            For X = 3 To .Range("C" & .Rows.Count).End(xlUp).Row '<--| loop through its column "C" cells from row 3 down to last not empty one
                If .cells(X, "C") = FindNo Then
                    .cells(X, 17) = val1
                    .cells(X, 18) = val2
                    .cells(X, 20) = val3
                    .cells(X, 21) = val4
                    .cells(X, 22) = val5
                End If
            Next X
            Range("Q:Q , T:T, U:U").WrapText = True
        End With
        .Close True
    End With

    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Mark Fitzgerald
Mark Fitzgerald

Reputation: 3068

Within your X = 3 to LastRow loop you are populating variables using the FoundRow range object but FoundRow has not been set.

Try replacing that loop with this:

For X = 3 To LastRow

    If SHT2.Cells(X, "C") = FindNo Then

        Set FoundCell = SHT2.Cells(X, "C")
        FRow = FoundCell.Row
        FColumn = FoundCell.Column
        Set FoundCell = Nothing
    SHT2.Range(Cells(FColumn + 14, FRow)) = SHT1.Cells(13, 1)
    SHT2.Range(Cells(FColumn + 15, FRow)) = SHT1.Cells(7, 6)
    SHT2.Range(Cells(FColumn + 17, FRow)) = SHT1.Cells(46, 2)
    SHT2.Range(Cells(FColumn + 18, FRow)) = SHT1.Cells(58, 2)
    SHT2.Range(Cells(FColumn + 19, FRow)) = SHT1.Cells(58, 13)

    End If

    Application.CutCopyMode = False

Next X

Upvotes: 0

Related Questions