CODEWITHSUNDEEP
excelexcel-formulavba
Dhilipkumar
Dhilipkumar

Reputation: 3

excel vba macro to match cells from two different workbooks and copy and paste accordingly and have to update only the empty cells

please help me in this..

I have two workbooks Bookone.xlsm and Booktwo.xlsm, bookone will be the source and booktwo is the target excel file.

Bookone and Booktwo has the below data. Source and target excel file snapshot

I just need to update the cells which is empty, but all the cells are getting updated including Non empty cells

Output of my VBA script. Output

Thanks in advance.. :)

My Code :

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long

Application.ScreenUpdating = False

Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1")


For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
    FR = 0
    On Error Resume Next
    FR = Application.Match(c, w2.Columns("A"), 0)
    On Error GoTo 0
    If FR <> 0 Then w2.Range("C" & FR).Value = c.Offset(, -3)
    If FR <> 0 Then w2.Range("C" & FR).Value.Interior.ColorIndex=8
Next c
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 588

Answers (1)

Axel Richter
Axel Richter

Reputation: 61890

You are searching the values from w1 column D in w2 column A. There all values will be found, except "Mach7". So all values will be updated.

You probably want only update if w2 column C is still empty. Then you must check this.

Sub UpdateW2()

 Dim w1 As Worksheet, w2 As Worksheet
 Dim c As Range, FR As Variant

 Application.ScreenUpdating = False

 Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1")
 Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1")

 For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
  FR = Empty
  FR = Application.Match(c, w2.Columns("A"), 0)
  If TypeName(FR) <> "Error" Then 'match was found
   If IsEmpty(w2.Range("C" & FR)) Then 'cell in w2 is still empty
    w2.Range("C" & FR).Value = c.Offset(, -3)
    w2.Range("C" & FR).Interior.ColorIndex = 8
   End If
  End If
 Next c

 Application.ScreenUpdating = True

End Sub

In opposite to WorksheetFunction.Match, Application.Match will not throw an error if no match is found. Instead it will return an error value. So no On Error... is needed here if you DIM the FRas Variant. Then you can check FR whether it is an error value.

Upvotes: 1

Related Questions