Set statement

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
467
Office Version
  1. 365
Platform
  1. Windows
Can anybody help me out a bit please I am trying to set up some code to open workbooks that are in a list from N2 to N8 (with a header in N1) on sheet cert data. What I eventually need to achieve is to copy certain data from each workbook as it opens, but at the moment I can get the workbooks to open but not close.
I may be completely wrong but I am trying to use a set statement so I can then reference that to close the workbook down
This is what I have tried
VBA Code:
Set wbk = Workbooks.Open(filename)
Set wbk = (directory & ThisWorkbook.Sheets("Cert Data").Range("N" & i).Value & ".xlsm")
Set Workbook = ("Cert Data").Range("N" & i).Value & ".xlsm")
But none of the above seem to work
Any help is appreciated
Full code below
VBA Code:
Sub CopyFromAllRegisters()
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

Dim i As Integer
Dim c As Integer
Dim directory As String
Dim filename As String
Dim ws As Worksheet
Dim wb As Workbook
Dim wbk As Workbook

Set wbk = Workbooks.Open(filename)
Set wb = ActiveWorkbook
Set ws = Worksheets("Cert Data")

'define location of material registers
directory = "L:\MATERIALS\Material Certification\"

'-----------------------------------------------------------------code to open each material register in turn
i = 1 'loop starts from here
For i = i + 1 To Cells(Rows.Count, "N").End(xlUp).Row 'a is the column name  where the filenames are stored

'define filename of material registers
filename = Dir(directory & ThisWorkbook.Sheets("Cert Data").Range("N" & i).Value & ".xlsm")

If filename = "" Then 'check if material register does not exist
Continue:
                             Else
Workbooks.Open (directory & filename), ReadOnly:=True 'open material register

'-----------------------------------------------------------------Need to add my code here




''-----------------------------------------------------------------to here
End If

wbk.Close (False)
Next i 'loop ends here and it will continue to last material register as it works down the list

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
There's no point in using both wbk and wb here:

Code:
Set wbk = Workbooks.Open(filename)
Set wb = ActiveWorkbook

since they both refer to the same workbook. Save the wb variable to use in the later workbooks.open line:

Code:
set wb = Workbooks.Open(directory & filename, ReadOnly:=True) 'open material register
 
Upvote 0
How about
VBA Code:
Sub CopyFromAllRegisters()
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

Dim i As Integer
Dim c As Integer
Dim directory As String
Dim filename As String
Dim ws As Worksheet
Dim wbk As Workbook

Set ws = ThisWorkbook.Worksheets("Cert Data")

'define location of material registers
directory = "L:\MATERIALS\Material Certification\"

'-----------------------------------------------------------------code to open each material register in turn
For i = 2 To Cells(Rows.Count, "N").End(xlUp).Row 'a is the column name  where the filenames are stored

   'define filename of material registers
   filename = Dir(directory & ws.Range("N" & i).Value & ".xlsm")
   
   If filename <> "" Then 'check if material register does not exist
      Set wbk = Workbooks.Open(directory & filename, ReadOnly:=True) 'open material register
      
      '-----------------------------------------------------------------Need to add my code here
      
      
      
      
      ''-----------------------------------------------------------------to here
   End If
   
   wbk.Close (False)
Next i 'loop ends here and it will continue to last material register as it works down the list

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
How about
VBA Code:
Sub CopyFromAllRegisters()
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

Dim i As Integer
Dim c As Integer
Dim directory As String
Dim filename As String
Dim ws As Worksheet
Dim wbk As Workbook

Set ws = ThisWorkbook.Worksheets("Cert Data")

'define location of material registers
directory = "L:\MATERIALS\Material Certification\"

'-----------------------------------------------------------------code to open each material register in turn
For i = 2 To Cells(Rows.Count, "N").End(xlUp).Row 'a is the column name  where the filenames are stored

   'define filename of material registers
   filename = Dir(directory & ws.Range("N" & i).Value & ".xlsm")
  
   If filename <> "" Then 'check if material register does not exist
      Set wbk = Workbooks.Open(directory & filename, ReadOnly:=True) 'open material register
     
      '-----------------------------------------------------------------Need to add my code here
     
     
     
     
      ''-----------------------------------------------------------------to here
   End If
  
   wbk.Close (False)
Next i 'loop ends here and it will continue to last material register as it works down the list

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
That's brilliant thank you so much
 
Upvote 0
There's no point in using both wbk and wb here:

Code:
Set wbk = Workbooks.Open(filename)
Set wb = ActiveWorkbook

since they both refer to the same workbook. Save the wb variable to use in the later workbooks.open line:

Code:
set wb = Workbooks.Open(directory & filename, ReadOnly:=True) 'open material register
Thanks very much for you help, really appreciated
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,949
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top