VBA code to vlookup data from another worksheet

phiyen8902 · May 29th 2019

I would like to limit the range in selection which only select within column (5) but I don’t know how to fix the code. My purpose is the macro only run if user choose range within column(5) because if they choose the range in other columns, the macro cant run well, otherwise the macro will be stopped or show the message to user that “pls choose in range column(5) only”. Pls help me to solve this problem. Thanks in advance.

Code

Public Sub Update_Data()
    Dim cell As Excel.Range
    For Each cell In Selection
        If (cell.Value = "") Then
          GoTo Continue
        End If
            cell.Offset(, 6).FormulaR1C1 = "=VLOOKUP(RC[-6],'[DAILY IMPORT STATUS 2019.- REVISEDxlsx.xlsx]Sheet1'!C6:C14,7,FALSE)"
            cell.Offset(, 6).Value2 = cell.Offset(, 6).Value2
            cell.Offset(, 7).FormulaR1C1 = "=VLOOKUP(RC[-7],'[DAILY IMPORT STATUS 2019.- REVISEDxlsx.xlsx]Sheet1'!C6:C14,8,FALSE)"
            cell.Offset(, 7).Value2 = cell.Offset(, 7).Value2
            cell.Offset(, 8).FormulaR1C1 = "=VLOOKUP(RC[-8],'[DAILY IMPORT STATUS 2019.- REVISEDxlsx.xlsx]Sheet1'!C6:C14,9,FALSE)"
            cell.Offset(, 8).Value2 = cell.Offset(, 8).Value2


Continue:
    Next cell
End Sub

Display More

Mumps · May 29th 2019

You may not need the formula at all and let the macro do the work. It would be easier to help and test possible solutions if you could attach a copy of your file, de-sensitized if necessary. Explain in detail what you are trying to do using a few examples from your data and referring to specific cells, rows, columns and sheets.

phiyen8902 · May 30th 2019

Hi Mumps,
[FONT="Times New Roman"]I try to update the information (col L,M,N) from Data wb into SHIP VIET wb (col K,L,M) base on invoice (col E). Because I want the macro only run in some lines what I choose in col E so that I use “For Each cell In Selection” and the macro can run well. However, when user choose the wrong col (other cols instead of col E), this code will remove the data in other cols because it will add the formula in col 6,7,8 count from col E. So that I want to reduce this problem by limited the col which was choosed by user, the macro only run if they choose right col E, otherwise the macro wont be run. Thanks your support. P/S: Pls see the attached file.[/FONT]

Mumps · May 30th 2019

Hopefully, I have understood correctly. Make sure that both workbooks are open. Place the macro below in a standard module in the "Ship Viet" workbook. Change the workbook name (in red) and the sheet name (in blue) to suit your needs. Save the workbook as a macro-enabled file. Run the macro.

Code

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, invoice As Range, fnd As Range
    Set srcWS = Workbooks("[COLOR=#FF0000]Data.xlsx[/COLOR]").Sheets("[COLOR=#0000FF]Sheet1[/COLOR]")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If ActiveCell.Column <> 5 Then
        MsgBox ("Please select a range in Column E.")
        Exit Sub
    Else
        For Each invoice In Selection
            Set fnd = srcWS.Range("F:F").Find(invoice, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                invoice.Offset(0, 6).Resize(1, 3).Value = fnd.Offset(0, 6).Resize(1, 3).Value
            End If
        Next invoice
    End If
    Application.ScreenUpdating = True
End Sub

Display More

Please note that the macro eliminates the need for any formulas.

phiyen8902 · May 31st 2019

Hi Mumps, Thanks for your generous help. The macro run very well, but could you please explain to me which lines of the code to get the data from (col L,M,N) of Data Wb and paste into (col K,L,M) of SHIPVIET? And how can it paste exactly to col K,L,M in SHIPVIET Wb? And if the col in SHIPVIET Wb and Data Wb arenot continously, could you give me some solutions ? I’m very new to VBA, hope that you can help me in this matter. Thanks again,Mumps.

Mumps · May 31st 2019

This line of code copies the data from

col L,M,N of Data Wb to col K,L,M of SHIPVIET:

Code

[align=left][COLOR=#252C2F][FONT=Courier][SIZE=12px]invoice.Offset(0, 6).Resize(1, 3).Value = fnd.Offset(0, 6).Resize(1, 3).Value[/SIZE][/FONT][/COLOR][/align]

Could you please attach a revised file where "the col in SHIPVIET Wb and Data Wb are not continuous"? This will allow me to see how your data is organized.

phiyen8902 · Jun 3rd 2019

Hi Mumps,

I use macro to add fomular into col T,U,V,X,Y,AC and AD, but the data of sheet Fr orders is too much, so that my code didn’t run well. I vlookup data from Data Wb (Outstanding sheet) into FR orders, and compare have any duplicate with sheet Fabship and Trimship. Pls see the attached file. Thanks for your generous help.

Code

Sub formula_FRorders()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim lRow As Long
    Set ws = Sheets("FR orders")
    With ws
        lRow = .Range("A" & .Rows.count).End(xlUp).row
        .Range("T2:T" & lRow).Formula = "=LEFT(RC[-18],10)"
        '.Range("T2:T" & lRow).Value2 = .Range("T2:T" & lRow).Value2
        .Range("U2:U" & lRow).Formula = "=IFERROR(VLOOKUP(RC[-19],[Data.xlsx]Outstanding!C1:C6,3,0),IFERROR(VLOOKUP(LEFT(RC[-19],10),[Data.xlsx]Outstanding!C1:C6,3,0),""-""))"
        '.Range("U2:U" & lRow).Value2 = .Range("U2:U" & lRow).Value2
        .Range("V2:V" & lRow).Formula = "=IFERROR(VLOOKUP(RC[-20],[Data.xlsx]Outstanding!C1:C6,4,0),IFERROR(VLOOKUP(LEFT(RC[-20],10),[Data.xlsx]Outstanding!C1:C6,4,0),""-""))"
        '.Range("V2:V" & lRow).Value2 = .Range("V2:V" & lRow).Value2
        .Range("X2:X" & lRow).Formula = "=IFERROR(VLOOKUP(RC[-22],[Data.xlsx]Outstanding!C1:C6,5,0),IFERROR(VLOOKUP(LEFT(RC[-22],10),[Data.xlsx]Outstanding!C1:C6,5,0),""-""))"
        '.Range("X2:X" & lRow).Value2 = .Range("X2:X" & lRow).Value2
        .Range("Y2:Y" & lRow).Formula = "=IFERROR(VLOOKUP(RC[-23],[Data.xlsx]Outstanding!C1:C6,6,0),IFERROR(VLOOKUP(LEFT(RC[-23],10),[Data.xlsx]Outstanding!C1:C6,6,0),""-""))"
        '.Range("Y2:Y" & lRow).Value2 = .Range("Y2:Y" & lRow).Value2
        .Range("AC2:AC" & lRow).Formula = "=IF(ISERROR(MATCH(RC[-18],FabShipping!C1,0)),"""",""DUPLICATE"")"
        '.Range("AC2:AC" & lRow).Value2 = .Range("AC2:AC" & lRow).Value2
        .Range("AD2:AD" & lRow).Formula = "=IF(ISERROR(MATCH(RC[-19],TrimShipping!C1,0)),"""",""DUPLICATE"")"
        '.Range("AD2:AD" & lRow).Value2 = .Range("AD2:AD" & lRow).Value2


    End With
    Application.ScreenUpdating = True
End Sub

Display More

Mumps · Jun 3rd 2019

Place the macro below in a standard module in the "FR" workbook. You will not need any formulas.

Code

[COLOR=#007000]Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, jobNum As Range, fnd As Range, code As Range
    Set srcWS = Workbooks("Data.xlsx").Sheets("Outstanding")
    Set desWS = Sheets("FR orders")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each jobNum In Range("B2:B" & LastRow)
        With desWS
            .Range("T" & jobNum.Row) = Left(jobNum, 10)
            Set fnd = srcWS.Range("A:A").Find(Left(jobNum, 10), LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                .Range("U" & jobNum.Row).Resize(, 2) = fnd.Offset(, 2).Resize(, 2).Value
                .Range("X" & jobNum.Row).Resize(, 2) = fnd.Offset(, 4).Resize(, 2).Value
            End If
            Set code = Sheets("FabShipping").Range("A:A").Find(Range("K" & jobNum.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not code Is Nothing Then
                .Range("AC" & jobNum.Row) = "DUPLICATE"
            Else
                .Range("AC" & jobNum.Row) = ""
            End If
            Set code = Sheets("TrimShipping").Range("A:A").Find(Range("K" & jobNum.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not code Is Nothing Then
                .Range("AD" & jobNum.Row) = "DUPLICATE"
            Else
                .Range("AD" & jobNum.Row) = ""
            End If
        End With
    Next jobNum
    Application.ScreenUpdating = True
End Sub[/COLOR]

Display More

phiyen8902 · Jun 10th 2019

Hi Mumps,

The macro can run exactly, however because of the huge data in my chart, the macro took more than 5min to finish its task (full information from col A to col T and nearly 15000 rows). Anyway, thanks for your help so much, Mumps

**KjBox** · Jun 10th 2019

Try this, it will be much faster with your full dataset

Code

Sub Test()
    Dim x, y, Jobs, Fab, Trm, i As Long, ii As Long
    
    With Workbooks("Data.xlsx").Sheets("Outstanding").Cells(1).CurrentRegion
        x = .Value
        Jobs = Application.Transpose(.Columns(2))
    End With
    With ThisWorkbook
        Fab = .Sheets("FabShipping").Cells(1).CurrentRegion
        Trm = .Sheets("TrimShipping").Cells(1).CurrentRegion
        With .Sheets("FR orders").Cells(1).CurrentRegion
            y = .Value
            For i = 2 To UBound(y, 1)
                If Not IsError(Application.Match(Left(y(i, 2), 10), Jobs, 0)) Then
                    ii = Application.Match(Left(y(i, 2), 10), Jobs, 0)
                    y(i, 20) = Left(y(i, 2), 10)
                    y(i, 21) = x(ii, 3): y(i, 22) = x(ii, 4): y(i, 24) = x(ii, 5): y(i, 25) = x(ii, 6)
                    If Not IsError(Application.Match(y(i, 11), Fab, 0)) Then y(i, 29) = "DUPLICATE"
                    If Not IsError(Application.Match(y(i, 11), Trm, 0)) Then y(i, 30) = "DUPLICATE"
                End If
            Next
            Application.ScreenUpdating = 0
            .ClearContents
            .Value = y
        End With
    End With
    
End Sub

Display More

**KjBox** · Jun 10th 2019

Have you tested the code in Post #10?

phiyen8902 · Jun 11th 2019

Hi KjBox,

Thanks so much for your generous help. It's only took around 2min to finish its task. Thank you again, KjBox.

**KjBox** · Jun 11th 2019

You're welcome.

phiyen8902 · Jul 1st 2019

Hi, I want to ask you one more thing about this code. If I have many Data sheets to fill in, how can I add all charts into this code. Thank you in advance.

Code

Set srcWS = Workbooks("Data.xlsx").Sheets("Sheet1")

Ex: DTC – SUMMARY CHART => get data from DTC – UPDATE
PFE– SUMMARY CHART => get data from PFE – UPDATE
CTT – SUMMARY CHART => get data from CTT – UPDATE
…. More than 10 charts like this.

Code

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, invoice As Range, fnd As Range
    Set srcWS = Workbooks("Data.xlsx").Sheets("Sheet1")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If ActiveCell.Column <> 5 Then
        MsgBox ("Please select a range in Column E.")
        Exit Sub
    Else
        For Each invoice In Selection
            Set fnd = srcWS.Range("F:F").Find(invoice, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                invoice.Offset(0, 6).Resize(1, 3).Value = fnd.Offset(0, 6).Resize(1, 3).Value
            End If
        Next invoice
    End If
    Application.ScreenUpdating = True
End Sub

Display More

VBA code to vlookup data from another worksheet

Participate now!

Share

Users Viewing This Thread