VBA Macro Vlook up

[Nawien]

Goodday everyone,

Sorry for my englisch


at the moment I am faced with a dilemma regarding vertical search with vba (So NOT with formula)

I have uploaded 2 files as an example.

File 1 (test2.xlsm):
in this file the values must be taken from file 2 (test.xlsm), but as follows,

File 1 (test2.xlsm):

Column A, below you will find the order numbers. these order numbers must match the order numbers of file 2 (test3.xlsm), if there is a match, all values of those rows (from column B and up to the last where in the row) must be transferred to file 1 (test2. xlsm) but then from column W in that specific row.

the above is done with the help of the button Update what you find in the file 2.

hope you can really help me.

Thank you for your cooperation

Greetings
nawien

 

[Kenneth Hobson]

Welcome to the forum!

Test on a backup copy of each file. Put in a Module, change wb1's name, open it, and then play this from wb2.

Sub Main()
  Dim wb1 As Workbook, wb2 As Workbook
  Dim f1 As Range, r1 As Range, r2 As Range, c2 As Range
  Dim r As Range, r1L As Range
  Dim s1 As Worksheet, s2 As Worksheet
  Dim nc As Long

  Set wb1 = Workbooks("ID 1.xlsm") 'Opened already
  Set wb2 = ThisWorkbook
  Set s1 = wb1.Worksheets(1)
  Set s2 = wb2.Worksheets(1)
  Set r1L = s1.Cells(Rows.Count, "A").End(xlUp)
  Set r1 = s1.Range("A2", r1L)
  Set r2 = s2.Range("A2", s2.Cells(Rows.Count, "A").End(xlUp))
  nc = s2.Cells(1, Columns.Count).End(xlToLeft).Column - 1

  For Each c2 In r2
    Set f1 = r1.Find(c2, r1L, xlValues, xlWhole, xlNext)
    If Not f1 Is Nothing Then
      Set r = c2.Offset(, 1).Resize(, nc)
      r.Copy s1.Cells(f1.Row, "W")
    End If
  Next c2

  Application.CutCopyMode = False
End Sub

 

[Nebu]

Hi:

You can easily do this using power query.

Thanks

 

[Nawien]

Hi:

You can easily do this using power query.

Thanks

i dont get this. im very bad in vba and qeury but still trying to understand this..

 

[Nawien]

Welcome to the forum!

Test on a backup copy of each file. Put in a Module, change wb1's name, open it, and then play this from wb2.

Sub Main()
  Dim wb1 As Workbook, wb2 As Workbook
  Dim f1 As Range, r1 As Range, r2 As Range, c2 As Range
  Dim r As Range, r1L As Range
  Dim s1 As Worksheet, s2 As Worksheet
  Dim nc As Long

  Set wb1 = Workbooks("ID 1.xlsm") 'Opened already
  Set wb2 = ThisWorkbook
  Set s1 = wb1.Worksheets(1)
  Set s2 = wb2.Worksheets(1)
  Set r1L = s1.Cells(Rows.Count, "A").End(xlUp)
  Set r1 = s1.Range("A2", r1L)
  Set r2 = s2.Range("A2", s2.Cells(Rows.Count, "A").End(xlUp))
  nc = s2.Cells(1, Columns.Count).End(xlToLeft).Column - 1

  For Each c2 In r2
    Set f1 = r1.Find(c2, r1L, xlValues, xlWhole, xlNext)
    If Not f1 Is Nothing Then
      Set r = c2.Offset(, 1).Resize(, nc)
      r.Copy s1.Cells(f1.Row, "W")
    End If
  Next c2

  Application.CutCopyMode = False
End Sub

Hi Kenneth,

it still not working.

 

[Nebu]

Hi:

I have not used any VBA code, but Power Query if you go to your power query editor you can follow the steps I have used to get the desired results.

Follow this link to know more on power query.

https://support.office.com/en-us/ar...or-excel-6e92e2f4-2079-4e1f-bad5-89f6269cd605

Thanks