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

 

[shahdelsol]

I appreciate that you have tried. So I went through your code step by step, when I hover over FileNum it exactly shows what it is in (j, 1) and when I hover over sFile it also tells me what the file name is but when I hover over ws1 it says " ws1=nothing" and I think this is where the problem is. Do you think this line of code has been written okay:

Set ws1 = Workbooks.Open(sFile, , True)​

Also this is where the code stops and I get the error. It seems like it is something missing here.

I don't think that is whats causing the error. Honestly I ran out of ideas the code I sent was tested and was working for me not sure why it does not work for you

 

[codeliftsleep]

use Like on a partial name:

WB.Name Like "partial match string"

 

[Truiz]

I appreciate that you have tried. So I went through your code step by step, when I hover over FileNum it exactly shows what it is in (j, 1) and when I hover over sFile it also tells me what the file name is but when I hover over ws1 it says " ws1=nothing" and I think this is where the problem is. Do you think this line of code has been written okay:

Set ws1 = Workbooks.Open(sFile, , True)​

Also this is where the code stops and I get the error. It seems like it is something missing here.

You could try using

Set ws1 = Workbooks.Open(sFile)

 

[shahdelsol]

It didn't work.

You could try using

Set ws1 = Workbooks.Open(sFile)

 

[shahdelsol]

I have used this code before how exactly to put it in this code:

[LEFT][COLOR=#333333][FONT=monospace]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[/FONT][/COLOR][/LEFT]

use Like on a partial name:

WB.Name Like "partial match string"

 

[Fluff]

Try this mod to the code provided by Truiz

Sub this()

   
   Dim j As Integer
   Dim ws1 As Workbook
   Dim ws2 As Workbook
   Dim FileNum As String
   Dim Pth As String
   
   
   For j = 14 To 32
      FileNum = Cells(j, 1)
      [COLOR=#0000ff]Pth = "C:\Order Entry\Orders\"[/COLOR]
      sFile = Dir([COLOR=#0000ff]Pth [/COLOR]& FileNum & "*" & ".xlsm")
      
      Set ws1 = Workbooks.Open([COLOR=#0000ff]Pth [/COLOR]& 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

 

[shahdelsol]

This worked. Thank you so much. First it didn't but then I realized the file extension should be xlsx in

sFile = Dir(Pth & FileNum & "*" & ".xlsm​

<strike></strike>

Thank you so much to everyone.
​

<strike></strike>

Try this mod to the code provided by Truiz

Sub this()

   
   Dim j As Integer
   Dim ws1 As Workbook
   Dim ws2 As Workbook
   Dim FileNum As String
   Dim Pth As String
   
   
   For j = 14 To 32
      FileNum = Cells(j, 1)
      [COLOR=#0000ff]Pth = "C:\Order Entry\Orders\"[/COLOR]
      sFile = Dir([COLOR=#0000ff]Pth [/COLOR]& FileNum & "*" & ".xlsm")
      
      Set ws1 = Workbooks.Open([COLOR=#0000ff]Pth [/COLOR]& 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

 

[Fluff]

Glad we could help & thanks for the feedback