Find the matching values and populate that row VBA

[DMO123]

Hi All,

I am wondering if someone would be able to help. I have been looking online for a similar code for the below but I cannot find anything close. I am looking for a VBA that does the following:

I have data in sheet 4 column “I” if column “H” is blank I need to search in sheet 3 for the matching value in column “I”. If its not in sheet 3 it then needs to look in sheet 2 and again if not there sheet 1. Once it finds the matching value it should copy the matching row from column A:L. paste the value in sheet 4 on the row which triggered the search. After it has pasted the value wherever it copied from it needs to delete that row.

This will need to loop down column “I” in sheet 4 until there is no more to do. If values are already there as in I and H is completed then don’t edit it.

I was using this code that I found but it only searches in one column and my VBA knowledge doesn’t help me in how to change it to a row. But I’m not even sure this will work either. It runs but nothing shows on the excel file.

Sub CopyRng2()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim Rng As Range
Dim Col As Long
Dim i As Long

On Error Resume Next 'Without this macro crashes if there's no match

Set WS1 = Sheets("Sheet4")
Set WS2 = Sheets("Sheet1")

Set Rng = WS1.Range("A:I")

With WS2
'Finds the column to copy:
Col = Application.WorksheetFunction.Match(WS1.Range("I").Value, .Rows("1:1"), False)
'Write the values individually:
For i = 1 To 5
.Cells(Choose(i, 1, 30, 15, 2, 9), Col).Value = Rng.Cells(i).Value
Next i
End With

End Sub

Any help would be appreciated!

 

[Fluff]

How about

Sub FindCopy()
   Dim Cl As Range, Fnd As Range
   Dim Sht As Worksheet
   
   With Sheets("Sheet4")
      For Each Cl In .Range("I2", .Range("I" & Rows.count).End(xlUp))
         If Cl.Offset(, -1) = "" Then
            For Each Sht In Sheets(Array("Sheet3", "sheet2", "sheet1"))
               Set Fnd = Sht.Range("I:I").find(Cl.Value, , , xlWhole, , , False, , False)
               If Not Fnd Is Nothing Then
                  Intersect(Fnd.EntireRow, Sht.Range("A:L")).Copy .Range("A" & Cl.Row)
                  Fnd.EntireRow.Delete
                  Exit For
               End If
            Next Sht
         End If
      Next Cl
   End With
End Sub

 

[mumps]

Where in sheets 1 to 3 do you want to search for the matching value in column “I”? Do you want to search the entire sheet, a particular row or a particular column? If a row or column, which row and which column?

 

[DMO123]

Sorry searching in column I - thanks!

 

[mumps]

@Fluff's solution should do the trick.

 

[DMO123]

This works perfectly! - as a learning opportunity could i ask you to add comments on the script so i know what each line is doing (if its not too much trouble).

 

[Fluff]

I've a better idea.
You tell me what you think it's doing as far as possible & I'll let you know if your right & fill in any blanks.

 

[DMO123]

Sure is the below correct?

Sub FindCopy()
   Dim Cl As Range, Fnd As Range 'declaring range
   Dim Sht As Worksheet 'declaring sheet
   
   With Sheets("Sheet4") 'look in sheet 4
      For Each Cl In .Range("I2", .Range("I" & Rows.Count).End(xlUp)) 'Find a value in column I
         If Cl.Offset(, -1) = "" Then 'Check if the column to the left of I is empty if it is then proceed
            For Each Sht In Sheets(Array("Sheet3", "sheet2", "sheet1")) 'declaring the sheets to check using array for order
               Set Fnd = Sht.Range("I:I").Find(Cl.Value, , , xlWhole, , , False, , False) 'using the declared sheets find the matching value in I but exact match
               If Not Fnd Is Nothing Then 'if nothing is returned then there is no matching values
                  Intersect(Fnd.EntireRow, Sht.Range("A:L")).Copy .Range("A" & Cl.Row) 'if match copy cells A:L to the corrisponding line
                  Fnd.EntireRow.Delete 'delete the found row
                  Exit For
               End If
            Next Sht 'loop between sheets
         End If
      Next Cl
   End With
End Sub

 

[Fluff]

When posting code please use code tags, the # icon in the reply window. It keeps the layout & makes it easier to follow.

You've got it pretty much spot on, just a couple of minor corrections

Sub FindCopy()
   Dim Cl As Range, Fnd As Range 'declaring range
   Dim Sht As Worksheet 'declaring sheet
   
   With Sheets("Sheet4") 'look in sheet 4
      For Each Cl In .Range("I2", .Range("I" & Rows.Count).End(xlUp)) [COLOR=#0000ff]'Loops through the used range on col I[/COLOR]
         If Cl.Offset(, -1) = "" Then 'Check if the column to the left of I is empty if it is then proceed
            For Each Sht In Sheets(Array("Sheet3", "sheet2", "sheet1")) 'declaring the sheets to check using array for order
               Set Fnd = Sht.Range("I:I").Find(Cl.Value, , , xlWhole, , , [COLOR=#ff0000]False[/COLOR], , False) 'using the declared sheets find the matching value in I but exact match, [COLOR=#0000ff]but not case sensitive[/COLOR] [COLOR=#0000ff]due to the part in red[/COLOR]
               If Not Fnd Is Nothing Then 'if nothing is returned then there is no matching values
                  Intersect(Fnd.EntireRow, Sht.Range("A:L")).Copy .Range("A" & Cl.Row) 'if match copy cells A:L to the corrisponding line
                  Fnd.EntireRow.Delete 'delete the found row
                  Exit For [COLOR=#0000ff]' Quits the loop through the sheets as value has been found[/COLOR]
               End If
            Next Sht 'loop between sheets
         End If
      Next Cl
   End With
End Sub

 

[DMO123]

Perfect! - thank you for your help much appreciated!