Macro to retrieve the value based on the column value in another

[sindhuja]

Hi,

Can anyone please assist on the below requirement.

I have a master file with all the error type with the department associated with each one. File will consist of almost 5000 error types.

I have another file in which only the error type will be given in column G for which we need to get the related department by using ctrl + F in the master sheet and paste the respective department in the column D of second file.

Since the second file has huge number of rows, it takes lot of time to complete the task.

Can this be done using macro without opening the file saved in the shared area.

I have attached 2 spreadsheet - Master sheet from which we need to find the dept for the value (in column L of file named Error).

Error spreadsheet will be open whereas the master spreadsheet is saved in the shared drive.

Pls assist.

-sindhuja

[Bob Phillips]

Don't cut and paste, use a formula to determine it.

[sindhuja]

Can you please assist with the requirement

[msuresh]

Plese Use the uploaded workbook.

Option Explicit

Sub find_paste_Department()

Dim erwb As Workbook
Set erwb = Workbooks("Error.xls")

Dim erws As Worksheet
Set erws = erwb.Sheets("Sheet1")

Dim mainwb As Workbook
Dim mainws As Worksheet
Dim lastcell_er As Range
Dim lastcell_mainws As Range
Dim search_word As String
Dim ercell As Range
Dim maincell As Range



Range("C2").Select

' you can change the file folder location

Workbooks.Open Filename:="C:\Users\msuresh\Desktop\Macro\VBAX project\Master.xls"
Set mainwb = Workbooks("Master.xls")
Set mainws = mainwb.Sheets("Sheet1")

erws.Activate

Set lastcell_er = erws.Range("k1").End(xlDown)

'mainwb.Activate
mainws.Activate

Set lastcell_mainws = mainws.Range("D2").End(xlDown)

erws.Activate

For Each ercell In erws.Range("K2:" & lastcell_er.Address)
For Each maincell In mainws.Range("D2:" & lastcell_mainws.Address)
If ercell.Value = maincell.Offset(0, 3) Then
maincell.Copy
ercell.Offset(0, -8).PasteSpecial xlPasteValues
Application.CutCopyMode = False

End If


Next maincell

Next ercell

Range("J1").Select
erwb.Save



End Sub

[sindhuja]

Thank you so much !!! Really helpful.. :)