Filling in blank cells with data from another workbook - VBA

[CC268]

​I have two different workbooks.


In Workbook 1 Column J contains Manufacturer Name. Some of the rows are filled in with the Manufacturer name while others are blank. I want to write VBA code that will go down each cell in Column J - if it is already filled in then don't worry about it, but if it is blank I want to take the Part Number in Column P and search for the corresponding Part Number in Workbook 2, Column A. If found copy the manufacturer in Column D and paste it back in Workbook 1 Column J.

Thanks!

[mancubus]

upload your workbooks. replace confidential data where necessary.
(dont know how, see my signature...)

[CC268]

upload your workbooks. replace confidential data where necessary.
(dont know how, see my signature...)

Here is sample data.Sample Workbook 1.xlsxSample Workbook 2.xlsx

[mancubus]

copy below code to a standard code module in WB 1, save it as xlsm, macro enabled workbook.

try it with backup files.

WB 2 must be open.

Sub vbax_58275_fill_blank_cells_from_another_workbook()

    Dim FoundCell As Range
    Dim LastRow As Long, i As Long
    
    On Error Resume Next
    With ThisWorkbook.Worksheets("Sheet1")
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        For i = 2 To LastRow
            If .Cells(i, 10) = "" Then
                Set FoundCell = Workbooks("Sample Workbook 2.xlsx").Worksheets("Sheet1").Columns(1).Find(.Cells(i, 16).Value)
                If Not FoundCell Is Nothing Then
                    .Cells(i, 10).Value = FoundCell.Offset(, 3).Value
                Else
                   .Cells(i, 10).Value = "Not found"
                End If
            End If
        Next i
    End With

End Sub

PS:
i assume part numbers in both workbooks are unique. otherwise Find method returns the first match.

you can remove below lines if you are sure there is always a match or if you want to leave cells blank when there is no match:

                Else
                   .Cells(i, 10).Value = "Not found"

[CC268]

Hmm...well it wrote Not found in all the blanks lol...but didn't do anything else

[CC268]

It works! I had the Workbook name written with .xlsx instead of .xlsm lol. Thanks a ton! Beautiful code!

If you don't mind me asking what in the world does this line of code do:

LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row

[mancubus]

you are welcome.
please mark the thread as solved from Thread Tools dropdown.

_________________________

quit excel
open a workbook with data.
make sure active cell in the active sheet with data is A1

turn macro recorder on
hit Ctrl + F key combination (or click Find & Select in Home Tab / Editing Group)
Find and Replace dialog pops up, "Find what" box containing an asterisk (*)
just click Find Next button
close the dialog
turn macro recorder off

now open VBE

recorded macro will show:

Sub Macro1()
'
' Macro1 Macro
''
    Cells.Find(What:="*", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate

End Sub 

now change xlNext to xlPrevious. and run the macro again. when you turn to excel you will see last non blank cell is selected.

Find Method Explained:
https://msdn.microsoft.com/en-us/lib.../ff839746.aspx

as you see this method has only one required parameter, which is "What".
so if you omit other optional parameters, default values are used. (Carefully read the Remarks in MS help page.)
and if you write the parameter values in function's/method's order, you don't need to write parameter names

so shorter version is:

Sub Macro1()
'
' Macro1 Macro
'
'
    Cells.Find("*", , , , xlByRows, xlPrevious).Activate

End Sub 

you can get this cell's row number, column number, address, etc by using related properties.

Sub FindLastNonBlankCellsProps()
     
    Dim LastDataCell As Range
    Dim LastRow As Long, LastCol As Long
    Dim LastAddr As String
    
    With ThisWorkbook.Worksheets("Sheet1")
        Set LastDataCell = .Cells.Find("*", , , , xlByRows, xlPrevious)
    End With
     
    With LastDataCell
        LastRow = .Row
        LastCol = .Column
        LastAddr = .Address
    End With
     
    MsgBox LastRow & vbLf & LastCol & vbLf & LastAddr

End Sub 

or

Sub FindLastNonBlankCellsProps()
     
    Dim LastRow As Long, LastCol As Long
    Dim LastAddr As String
    
    With ThisWorkbook.Worksheets("Sheet1")
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        LastCol = .Cells.Find("*", , , , xlByRows, xlPrevious).Column
        LastAddr = .Cells.Find("*", , , , xlByRows, xlPrevious).Address
    End With
     
    MsgBox LastRow & vbLf & LastCol & vbLf & LastAddr
End Sub 

[CC268]

Thanks for the help I appreciate it!