VBA for referring to workbook in directory by partial name based on a value in cell and copy and paste

[shahdelsol]

I am trying to come up with VBA that finds a workbook in directory based on a value in A14 that is part of book name. Let's say A14 = 123456, there is a workbook named 123456 abc.xlsx in directory ( I have named this book ws1) and then copy a few values from that book and paste it in the current book ( I have named it ws2). The way it works, if A14 of ws2 has a value then macro will look for that value as a partial name in directory once found will simply copy and past a few cells into ws2 and does the same thing for A15 and through A32 if not found message box will say file doesn't exist. This is what I have come up with but I know it has some issue and I am asking for help on correction. Also if it matters in directory there are hundreds of files that they all have the same name format 123456 abc.xlsx , 123459 ada.xlsx and so on. Thanks

 Dim j As Integer
Dim ws1 As Workbook
Dim ws2 As Workbook
For j = 14 To 32
FileNum = Cells(j, 1)
ws1 = "C:\Order Entry\Orders\" & FileNum & " *" & ".xlsx"
ws2 = Workbooks("Invoice.xlsm")
If ws2.Sheet1.Cells(j, 1) <> "" Then
 ws2.Sheet1.Cells(j, 2) = ws1.Sheet1.Range("f1")
 ws2.Sheet1.Cells(j, 6) = ws1.Sheets("sheet1").Range("B17")
 ws2.Sheet1.Cells(j, 7) = ws1.Sheets("sheet1").Range("D25")
 
 Next j
 
 Else
 
 MsgBox "Your file doesn't exist"
 
 End If
 
 End Sub

 

[Truiz]

Is this suppose to loop thru different files and copy from different files to the "Invoice.xlsm" workbook?
What cells from "Invoice.xlsm" are you pasting to?

Sorry but I have trouble understanding your desired outcome, if you could show us what you have and what you want to get done it would help

 

[shahdelsol]

Is this suppose to loop thru different files and copy from different files to the "Invoice.xlsm" workbook?
What cells from "Invoice.xlsm" are you pasting to?

Sorry but I have trouble understanding your desired outcome, if you could show us what you have and what you want to get done it would help

Sorry for confusion. So on WS2 (invoice.xlsm) user will type 6 digit number. In the directory there are files that have been named with this 6 digit number like 123456 abc.xlsx. Once this file found which I have called it WS1,I want to copy a few cells from this file meaning 123456 abc.xlsx (ws1) and past it in WS2 that user is inputting the 6 digit number in A14. User will input another 6 digit in A15 of WS2 and again vba looks for file with that 6 digit number in the directory and copy and paste the targeted cells to WS2 and so on to A32. Perhaps the whole set up is wrong but essentially this is what I want to accomplish finding files (that are closed and are in the same directory) based on partial name in the book that is open and being used and once found to copy a few cells of the closed books in the directory and paste them in the open book. Does this make sense?

 

[Truiz]

I undersand that but were on the ws2 are you pasting this information? for example based on the 6 digits in A14 were do the information will be pasted to and for the 6 digit in A1 were will it go ?

 

[shahdelsol]

I undersand that but were on the ws2 are you pasting this information? for example based on the 6 digits in A14 were do the information will be pasted to and for the 6 digit in A1 were will it go ?

The 6 digit will go to A14 , A15 and until A32 by the user into invoice file (ws2). The user will type the 6 digit in one of these cells and leave it there and based on that we need to find a file with that name in the directory. Once found, F1 of that fill (ws1) will go to B14 (ws2) , B17 of that file (ws1) will go to F14 (ws2), and D17 (ws1) goes to G14 (ws2) and this all will trigger if there is a 6 digit number in A14 and the same rule applies to next line which is A15, B15 , F15 and G15 and so on until A32, B32 ... and again only if there is a six digit number in any of A14 to A32. Nothing will happen if there is nothing in A14 of invoice (ws2) and codes to next line to check if there is six digit in A15 until A32 and if there is a 6 digit number , will trigger the code meaning will find the file and copy and paste. I hope this answered your question.

 

[Truiz]

Alright so I came up with something.

This will prompt for you to select the files you want to open, I chose this method because as far as I know you can't pass a partial name to excel like you requested, excel needs a full path and file name in order to open a file, with just a partial match how would excel or yourself know what file needs to open if you have a directory with 100 files all starting with 2017xxx xxx being variable how can excel know which files to open and which not to???? so by opening the file dialog and selecting the files we are instructing and passing and array to excel to work with. if you still rather have excel open the files based on your cells we need to hardcode the whole file name so for example lets say A14 thru 32 have dates and the file names have datesXXX XXX needs to be inside the code. let me know if this works for you please

Sub cp()
Dim eWorkbook, iWorkbook As Workbook
Set eWorkbook = ThisWorkbook
Dim i, z As Long
Dim iWorkbookImportOpen As Variant


'THIS TURNS OFF ANY ALERT BOXES (TEMPORARILY) THAT MAY INTERFERE WITH THE IMPORT PROCESS
Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual


'PROMPTS THE DIALOG BOX - FILTERS ON EXCEL FILES ONLY
iWorkbookImportOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xlsx; *.xlsm; *.xls; *.xltm), *.xlsx; *.xlsm; *.xls; *.xltm", _
Title:="Select Import File", MultiSelect:=True)
On Error GoTo ExitSub


j = 14


'SINCE MULTISELECT IS TRUE - LBOUND = LOWEST NUMBER OF THE WORKBOOKS SELECTED WHICH IS ALWAYS 1, UBOUND IS THE HIGHEST NUMBER OF THE WORKBOOKS SELECTED
For i = LBound(iWorkbookImportOpen) To UBound(iWorkbookImportOpen)


'DECLARES THE CURRENT IMPORT WORKBOOK IN THE CYCLE AND OPENS AS A READ ONLY
Set iWorkbook = Workbooks.Open(Filename:=iWorkbookImportOpen(i), ReadOnly:=True)


'ON THE IMPORTED WORKBOOK, ON THE FIRST WORKSHEET, COPY THE DATA WE NEED TO THE CURRENT FILE
ThisWorkbook.Sheets(1).Cells(j, 2) = iWorkbook.Sheets(1).Range("F1")
ThisWorkbook.Sheets(1).Cells(j, 6) = iWorkbook.Sheets(1).Range("B17")
ThisWorkbook.Sheets(1).Cells(j, 7) = iWorkbook.Sheets(1).Range("D25")


j = j + 1
'CLOSE THE CURRENT IWORKBOOK/IMPORT WORKBOOK WITHOUT SAVING
iWorkbook.Close SaveChanges:=False




'MOVES TO THE NEXT IMPORT WORKBOOK IF THERE WERE MULTIPLE WORKBOOKS SELECTED IN THE DIALOG BOX
Next i




'TURNS BACK ON ANY EXCEL ALERTS
Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
ExitSub: Exit Sub
End Sub

 

[shahdelsol]

Alright so I came up with something.

This will prompt for you to select the files you want to open, I chose this method because as far as I know you can't pass a partial name to excel like you requested, excel needs a full path and file name in order to open a file, with just a partial match how would excel or yourself know what file needs to open if you have a directory with 100 files all starting with 2017xxx xxx being variable how can excel know which files to open and which not to???? so by opening the file dialog and selecting the files we are instructing and passing and array to excel to work with. if you still rather have excel open the files based on your cells we need to hardcode the whole file name so for example lets say A14 thru 32 have dates and the file names have datesXXX XXX needs to be inside the code. let me know if this works for you please

Sub cp()
Dim eWorkbook, iWorkbook As Workbook
Set eWorkbook = ThisWorkbook
Dim i, z As Long
Dim iWorkbookImportOpen As Variant


'THIS TURNS OFF ANY ALERT BOXES (TEMPORARILY) THAT MAY INTERFERE WITH THE IMPORT PROCESS
Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual


'PROMPTS THE DIALOG BOX - FILTERS ON EXCEL FILES ONLY
iWorkbookImportOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xlsx; *.xlsm; *.xls; *.xltm), *.xlsx; *.xlsm; *.xls; *.xltm", _
Title:="Select Import File", MultiSelect:=True)
On Error GoTo ExitSub


j = 14


'SINCE MULTISELECT IS TRUE - LBOUND = LOWEST NUMBER OF THE WORKBOOKS SELECTED WHICH IS ALWAYS 1, UBOUND IS THE HIGHEST NUMBER OF THE WORKBOOKS SELECTED
For i = LBound(iWorkbookImportOpen) To UBound(iWorkbookImportOpen)


'DECLARES THE CURRENT IMPORT WORKBOOK IN THE CYCLE AND OPENS AS A READ ONLY
Set iWorkbook = Workbooks.Open(Filename:=iWorkbookImportOpen(i), ReadOnly:=True)


'ON THE IMPORTED WORKBOOK, ON THE FIRST WORKSHEET, COPY THE DATA WE NEED TO THE CURRENT FILE
ThisWorkbook.Sheets(1).Cells(j, 2) = iWorkbook.Sheets(1).Range("F1")
ThisWorkbook.Sheets(1).Cells(j, 6) = iWorkbook.Sheets(1).Range("B17")
ThisWorkbook.Sheets(1).Cells(j, 7) = iWorkbook.Sheets(1).Range("D25")


j = j + 1
'CLOSE THE CURRENT IWORKBOOK/IMPORT WORKBOOK WITHOUT SAVING
iWorkbook.Close SaveChanges:=False




'MOVES TO THE NEXT IMPORT WORKBOOK IF THERE WERE MULTIPLE WORKBOOKS SELECTED IN THE DIALOG BOX
Next i




'TURNS BACK ON ANY EXCEL ALERTS
Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
ExitSub: Exit Sub
End Sub

Thanks for getting back to me. This was a lot more complicated than I thought. It is working however it is asking for user to find the file manually where you have to find the file and open it. This is something I wanted to avoid. Can you refer to the workbook where the file is (

C:\Order Entry\Orders\​

) without opening it manually. The part of workbook name is in A14 where user will input it and it is 6 digit number. The actual workbook name is like this : 123456 abc.xlsx but the user is inputting 123456 in A14

 

[Truiz]

In order to able to open the file using the cell reference we would need to hardcode the abc with the actual name ie.

if Cell A14 has 123456 and the actual file name we want to open its called 123456ABC we need to have ABC in the code the tricky part is what if cell A15 has 234567 and the file we want to open is called 234567XYZ ... the only way we can open the files using the cell reference is that if all the files after the sex digits have the same suffix ie 123456ABC 234567ABC 345678ABC and so on...

 

[shahdelsol]

In order to able to open the file using the cell reference we would need to hardcode the abc with the actual name ie.

if Cell A14 has 123456 and the actual file name we want to open its called 123456ABC we need to have ABC in the code the tricky part is what if cell A15 has 234567 and the file we want to open is called 234567XYZ ... the only way we can open the files using the cell reference is that if all the files after the sex digits have the same suffix ie 123456ABC 234567ABC 345678ABC and so on...

What comes after the 6 digit is not always the same. The 6 digit numbers are unique so as what comes after it for every file but I thought we could look for a file with partial name something like

If wb.Name Like "123456*" Then

 

[Truiz]

Let's try this.

Sub this()


Dim j As Integer
Dim ws1 As Workbook
Dim ws2 As Workbook


For j = 14 To 32
FileNum = Cells(j, 1)
sFile = Dir("C:\Users\jbuitrago\Documents\VBATest\" & FileNum & "*" & ".xlsx")


Set ws1 = Workbooks.Open(sFile, , True)
Set ws2 = Workbooks("Invoice.xlsm")
If ws2.Sheets(1).Cells(j, 1) = "" Then
ws1.Close SaveChanges:=False
Exit For
End If
 ws2.Sheets(1).Cells(j, 2) = ws1.Sheets(1).Range("F1")
 ws2.Sheets(1).Cells(j, 6) = ws1.Sheets(1).Range("B17")
 ws2.Sheets(1).Cells(j, 7) = ws1.Sheets(1).Range("D25")
 ws1.Close SaveChanges:=False
 
 Next
 End Sub