"Parsing" data from one .xlsx to another using vlookup

Anton84 · Nov 5, 2017

Good afternoon to everyone!

I have a challenge!)

I have a file, for instance in

Code:

[COLOR=#666666][FONT=monospace]"G:\N.xlsx"[/FONT][/COLOR]

In this file I have a list of numbers in first column like
1
2
3
4
5
6
In second one:

A
B
C
D
E
F

So, it all looks like:

1A
2B
3C
4D
5E
6F

Also I have many files (for example, about 6 .xlsx files) in "G:\1"

In every of each file in

Code:

Cells (1,1)

I have a value from 1 to 6, for example)

I need to paste in every file in "G:\1" information from N.xlsx file...

In a way to have: in file with

Code:

Cells(1,1).Value

=4 Ill get in

Code:

Cell(1,2).Value

= "D"

Well...I have a piece of code, but I don't understand VBA syntax to end my challenge)

This code is only foggy direction of thinking how it should be. Something like:

Code:

[COLOR=#000099][FONT=monospace]Sub[/FONT][/COLOR][COLOR=#000000][FONT=monospace] rrr()[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]Dim[/FONT][/COLOR][COLOR=#000000][FONT=monospace] wb_ [/FONT][/COLOR][COLOR=#000099][FONT=monospace]As[/FONT][/COLOR][COLOR=#000000][FONT=monospace] Workbook[/FONT][/COLOR]
[COLOR=#000000][FONT=monospace]        Application.ScreenUpdating = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]False[/FONT][/COLOR]

[COLOR=#000000][FONT=monospace]    fp_ = [/FONT][/COLOR][COLOR=#666666][FONT=monospace]"G:\1\"[/FONT][/COLOR]

[COLOR=#000000][FONT=monospace]    fv_ = [/FONT][/COLOR][COLOR=#666666][FONT=monospace]"G:\N.xlsx"[/FONT][/COLOR]

[COLOR=#000000][FONT=monospace]    fvn_ = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#000000][FONT=monospace](fv_)[/FONT][/COLOR]

[COLOR=#000000][FONT=monospace]    fn_ = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#000000][FONT=monospace](fp_ & [/FONT][/COLOR][COLOR=#666666][FONT=monospace]"*.xls*"[/FONT][/COLOR][COLOR=#000000][FONT=monospace], vbNormal)[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]On[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Error[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Resume[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Next[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]Do[/FONT][/COLOR][COLOR=#000099][FONT=monospace]While[/FONT][/COLOR][COLOR=#000000][FONT=monospace] fn_ <> [/FONT][/COLOR][COLOR=#666666][FONT=monospace]""[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]Set[/FONT][/COLOR][COLOR=#000000][FONT=monospace] wb_ = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]GetObject[/FONT][/COLOR][COLOR=#000000][FONT=monospace](fp_ & fn_)[/FONT][/COLOR]

[COLOR=#000099][FONT=monospace]On[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Error[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Resume[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Next[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]With[/FONT][/COLOR][COLOR=#000000][FONT=monospace] wb_.Sheets([/FONT][/COLOR][COLOR=#666666][FONT=monospace]"rrrrr"[/FONT][/COLOR][COLOR=#000000][FONT=monospace])[/FONT][/COLOR]
[COLOR=#000000][FONT=monospace]                .Cells([/FONT][/COLOR][COLOR=#CC0000][FONT=monospace]1[/FONT][/COLOR][COLOR=#000000][FONT=monospace], [/FONT][/COLOR][COLOR=#CC0000][FONT=monospace]2[/FONT][/COLOR][COLOR=#000000][FONT=monospace]) = Application.WorksheetFunction.VLookup(Cells([/FONT][/COLOR][COLOR=#CC0000][FONT=monospace]1[/FONT][/COLOR][COLOR=#000000][FONT=monospace], [/FONT][/COLOR][COLOR=#CC0000][FONT=monospace]1[/FONT][/COLOR][COLOR=#000000][FONT=monospace]), fvn_.Range([/FONT][/COLOR][COLOR=#666666][FONT=monospace]"A2:B1000"[/FONT][/COLOR][COLOR=#000000][FONT=monospace]), [/FONT][/COLOR][COLOR=#CC0000][FONT=monospace]2[/FONT][/COLOR][COLOR=#000000][FONT=monospace], [/FONT][/COLOR][COLOR=#000099][FONT=monospace]False[/FONT][/COLOR][COLOR=#000000][FONT=monospace])[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]End[/FONT][/COLOR][COLOR=#000099][FONT=monospace]With[/FONT][/COLOR]

[COLOR=#000000][FONT=monospace]        wb_.Close [/FONT][/COLOR][COLOR=#000099][FONT=monospace]False[/FONT][/COLOR]
[COLOR=#000000][FONT=monospace]        lr_ = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]Empty[/FONT][/COLOR]
[COLOR=#000000][FONT=monospace]        fn_ = [/FONT][/COLOR][COLOR=#000099][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#000000][FONT=monospace]()[/FONT][/COLOR]
[COLOR=#000099][FONT=monospace]Loop[/FONT][/COLOR]

[COLOR=#000099][FONT=monospace]End[/FONT][/COLOR][COLOR=#000099][FONT=monospace]Sub[/FONT][/COLOR]

May be I dont need vlookup at all to have my challenge done...

Please, help me to end it!

Kenneth Hobson · Nov 5, 2017

Welcome to the forum!

Code:

Sub Main()  'In a Module in N.xlsm.  
  Dim wb As Workbook, ws As Worksheet, fp$, fn$
  Dim calc As Integer, r As Range, f As Range
  
'************** CHANGE TO SUIT ************
  fp = "c:\1\"
'************** END CHANGE ****************
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  'Set range in N.xlsm to search.
  With ThisWorkbook.Worksheets(1)
    Set r = Intersect(.UsedRange, .Columns(1))
  End With
   
  fn = Dir(fp & "*.xls*")
  Do While fn <> ""
    Set wb = Workbooks.Open(fp & fn)
 '************ CHANGE NEXT LINE TO SUIT ********
    Set ws = wb.Worksheets(1)
    Set f = r.Find(ws.[A1], after:=r.Cells(r.Rows.Count, r.Columns.Count))
    If f Is Nothing Then GoTo NextFN
    ws.[B1].Value = f.Offset(, 1).Value
    wb.Close True
NextFN:
    fn = Dir()
  Loop
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .DisplayAlerts = True
    '.CutCopyMode = False
  End With
End Sub

Anton84 · Nov 6, 2017

Good morning to everyone and to Kenneth Hobson !

My decision was like:

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim wb2 As Workbook
Dim myPath As String
Dim myPath2 As String
Dim myFile As String
Dim myFile2 As String
Dim myExtension As String
Dim myExtension2 As String

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

myPath = "G:\1"
myPath2 = "G:"
NextCode:

myPath = myPath
myPath2 = myPath2

If myPath = "" Then GoTo ResetSettings
If myPath2 = "" Then GoTo ResetSettings

myExtension = "*.xls*"
myExtension2 = "N.xlsx"

myFile2 = Dir(myPath2 & myExtension2)
myFile = Dir(myPath & myExtension)

Do While myFile <> ""

Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents

wb.Worksheets(1).Select
n = Cells(1, 1).Value
Set wb2 = Workbooks.Open(Filename:=myPath2 & myFile2)
On Error Resume Next
wb.Worksheets(1).Cells(5, 5).Value = Application.WorksheetFunction.VLookup(n, wb2.Worksheets(1).Range("A1:B100"), 2, False)

wb.Close SaveChanges:=True
wb2.Close SaveChanges:=True

DoEvents

myFile = Dir
' myFile2 = Dir
Loop

ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

But Your is interesting too

How to use "code quotes" on the panel???))
There is nothing to do so!)

Anton84 · Nov 6, 2017

My decision was

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim wb2 As Workbook
Dim myPath As String
Dim myPath2 As String
Dim myFile As String
Dim myFile2 As String
Dim myExtension As String
Dim myExtension2 As String

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

myPath = "G:\1"
myPath2 = "G:"
NextCode:

myPath = myPath
myPath2 = myPath2

If myPath = "" Then GoTo ResetSettings
If myPath2 = "" Then GoTo ResetSettings

myExtension = "*.xls*"
myExtension2 = "N.xlsx"

myFile2 = Dir(myPath2 & myExtension2)
myFile = Dir(myPath & myExtension)

Do While myFile <> ""

Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents

wb.Worksheets(1).Select
n = Cells(1, 1).Value
Set wb2 = Workbooks.Open(Filename:=myPath2 & myFile2)
On Error Resume Next
wb.Worksheets(1).Cells(5, 5).Value = Application.WorksheetFunction.VLookup(n, wb2.Worksheets(1).Range("A1:B100"), 2, False)

wb.Close SaveChanges:=True
wb2.Close SaveChanges:=True

DoEvents

myFile = Dir
' myFile2 = Dir
Loop

ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Were can I find code quotes?)))

Thanks to everyone for your help!!

"Parsing" data from one .xlsx to another using vlookup

Anton84

New member

Attachments

Kenneth Hobson

New member

Anton84

New member

Anton84

New member