I'm trying to access information from other workbooks and populate that information in a central location. Specifically, I'm trying to write a function that can be used in a cell that will return the UsedRange.Count of the target Workbook.
The problem is that I keep getting an Err #9 or #91 when I try to point to the workbook object. I am 99.99% sure I am naming the file correctly.
What's more, when I run the code as a Sub as opposed to a Function it works fine.
Here is the working Sub:
Sub test()
Dim wb As Workbook
Dim wb2 As Workbook
Dim fileName As String
Dim rootDir As String
Dim BigSum As Integer
rootDir = ActiveWorkbook.Path
fileName = "TestSheet1"
Set wb = ActiveWorkbook
MsgBox rootDir
On Error Resume Next
Set wb2 = Workbooks(fileName & ".xlsx")
Set wb2 = Workbooks.Open(rootDir & "\Test1\" & fileName & ".xlsx")
MsgBox wb2.Worksheets("Sheet1").Range("A3").Value2
BigSum = wb2.Worksheets("Sheet1").UsedRange.Count - 2
MsgBox BigSum
End Sub
Now here's an example of the Function:
Function Adder(exTension As String, fileName As String) As Integer
Dim wb As Workbook
Dim wb2 As Workbook
Dim rootDir As String
rootDir = ActiveWorkbook.Path
Set wb = ActiveWorkbook
On Error GoTo errHandler
Set wb2 = Workbooks(fileName & ".xlsx")
Set wb2 = Workbooks.Open(rootDir & "\" & exTension & "\" & fileName & ".xlsx")
Adder = wb2.Worksheets("Sheet1").UsedRange.Count - 2
MsgBox Adder
errHandler:
MsgBox Err.Number
Resume exitHere
exitHere:
End Function
As far as I can tell, there's no real difference between these. Is this a issue with scope?
Related
I have two Excel Files in the same folder. The macro runs on the master workbook (wb_master). It should copy the sheet from the Data Workbook (wb_Data) to wb_master.
My attempt is this:
Dim wb_name as String
Dim wb_master as Object
Dim ws_master as Object
Dim wb_Data As Object
Dim MyPath as String
Dim DataFile as String
wb_name = ActiveWorkbook.Name 'other users could have renamed the wb, so I don't want to refer to the name with a fixed string
Set wb_master = Workbooks(wb_name)
Set ws_master = wb_master.Worksheets(1)
MyPath = ActiveWorkbook.Path
DataFile = Dir(MyFolder & "\Data_*.xlsx")
Set wb_Data = Workbooks.Open(FileName:=MyPath & "\" & DataFile)
wb_Data.Sheets(1).Copy After:=wb_master.Sheets(1)
wb_Data.Close SaveChanges:=False
The problem with this is, that in the line where it copies wb_Data.Sheets(1) it doesn't use the wb_master workbook, but the wb_data workbook as destination. I assume this is because when wb_master is called, it reevaluates the ActiveWorkbook, which at this point is wb_Data.
However even though I understand, why this is happening, I can't find a solution to the problem.
Edit: This macro runs in the personal.xslb
Copy Sheet From a Closed Workbook
If you run the code from the Personal.xslb, then replace ThisWorkbook with ActiveWorkbook or the appropriate workbook e.g. Workbooks("Master.xlsm").
Option Explicit
Sub CopySheet()
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
Dim FolderPath As String: FolderPath = dwb.Path & "\"
Dim swbName As String: swbName = Dir(FolderPath & "Data_*.xlsx")
If Len(swbName) = 0 Then Exit Sub ' file not found
Dim sFilePath As String: sFilePath = FolderPath & swbName
Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
Dim ssh As Object: Set ssh = swb.Sheets(1)
ssh.Copy After:=dwb.Sheets(1) ' second sheet
'ssh.Copy Before:=dwb.Sheets(1) ' first sheet
'ssh.Copy After:=dwb.Sheets(dwb.Sheets.Count) ' last sheet
swb.Close SaveChanges:=False
MsgBox "Sheet copied.", vbInformation
End Sub
I am currently using following code to save an Excel workbook. Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Sub Button3_Click()
' Yes
' Code to save consumer wise mirs on the desktop
Dim Path As String
Dim filename As String
On Error GoTo Err_Clear
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Err_Clear:
If Err <> 0 Then
MkDir CreateObject("wscript.shell").specialfolders("desktop") & "\rohailnisar"
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End Sub
Export a Worksheet
This saves a copy of a worksheet as the only sheet in a new workbook in the same folder. Before saving, it converts formulas to values. It is saved in the .xlsx format 'removing' any code.
If the code is in the open (initial) workbook, then replace ActiveWorkbook with ThisWorkbook.
Option Explicit
Sub SaveWorksheet()
On Error GoTo ClearError
Dim swb As Workbook: Set swb = ActiveWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets("Reconciliation")
Dim FolderPath As String: FolderPath = swb.Path & Application.PathSeparator
Dim BaseName As String: BaseName = sws.Range("E1").Value
Dim FilePath As String: FilePath = FolderPath & BaseName & ".xlsx"
sws.Copy
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
dwb.Worksheets(1).UsedRange.Value = dwb.Worksheets(1).UsedRange.Value
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
'dwb.Close
ProcExit:
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Code
Dim wbThis As Workbook
Dim wsThis As Worksheet
Dim wbThat As Workbook
Dim wsThat As Worksheet
'~~> Change this to the workbook which has the Reconciliation sheet
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Reconciliation")
'~~> This will create a new workbook with only Reconciliation
wsThis.Copy
'~~> Get that object. It will be last in the queue
Set wbThat = Workbooks(Workbooks.Count)
Set wsThat = wbThat.Sheets("Reconciliation")
'~~> Convert to values
wsThat.UsedRange.Value = wsThat.UsedRange.Value
'~~> Save that workbook
wbThat.SaveAs Filename:=Path & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
in my code I want to prompt the user for a custom workbook name and then saving said workbook on the desktop. For some reason I am getting a Run time error 9 - Subscript out of range when I try to set my workbook to the FilePath. I did some sleuthing around on other posts and I am unsure why I am still getting the error. Is there a better way to do it than mine/ where is my mistake?
Dim WB As Workbook
Dim WS As Worksheet
Dim WorkbookName As String
Dim FilePath As String
WorkbookName = InputBox("What Do you Want to Name the New Workbook?")
FilePath = "C:\Users\JoeK\Desktop\" & WorkbookName & ".xlsx"
'error is at the line below
Set WB = Workbooks(FilePath)
Set WS = Sheets("Sheet1")
Sub CreateEmptyWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim workbookName As String
Dim filePath As String
workbookName = "test"
filePath = GetDesktopPath & workbookName & ".xlsx"
Set wb = Workbooks.Add
wb.SaveAs filePath
wb.Close False
End Sub
Public Function GetDesktopPath() As String
GetDesktopPath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
End Function
Set wb = Workbooks.Add - adds the workbook, thus it is empty;
wb.SaveAs filePath - saves it to the filePath, which is the one on the Desktop;
wb.Close False - closing it is needed as well, the False argument is for saving changes. As far as nothing is done in the workbook, this arg it could be True as well;
I'm trying to open two separate workbooks via VBA in Excel and, somehow, the same code lines work in one case, but do not in the second one.
My first code line works properly:
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
The second one, however, do not, it does open the file, but do not store it as wb2 and returns a Mistype error.
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1,UpdateLinks:=xlUpdateLinksNever)
[EDIT] This is the whole code set:
Option Explicit
Sub Update_Supply_Concerns()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim wb, WB1, WB2 As Workbooks
Dim ws, ws1, ws2 As Worksheets
Dim path, path1, path2 As String
Dim fName, fName1, fName2 As String
Dim uName As String
Dim rDate As String
Dim fExt, fExt1 As String
uName = Environ$("username")
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Macro")
With ws
.Activate
rDate = .Range("D6").Value
path = "C:\Users\" & uName & "\Documents\Projects\" & rDate & "\"
fName = "Hospital"
fExt = ".xlsx"
path1 = "C:\Users\" & uName & "\Box Sync\Supply Concerns 2.0\"
fName1 = "Supply Concerns v2"
fExt1 = ".xlsx"
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1, UpdateLinks:=xlUpdateLinksNever)
End With
End Sub
I've tried activating the parent workbook before attempting to open the second file, with no success.
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
wb.Activate
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1, UpdateLinks:=xlUpdateLinksNever)
A problem is that
Dim wb, WB1, WB2 As Workbooks
doesn't do what you think it does. It declares wb, WB1 as simple Variants and then declares WB2 as a Workbooks (note the "s"!) object. It doesn't declare any of those three variables as a Workbook object.
Since WB1 is a variant (which can hold a workbook object) the line
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
is unproblematic. But since WB2 is declared to be a workbooks object, the line
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1,UpdateLinks:=xlUpdateLinksNever)
is a type mismatch since you are trying to use a workbooks variable to hold a workbook object.
To start fixing your code, use the declaration:
Dim wb As Workbook, WB1 As Workbook, WB2 As Workbook
(and fix some of your other declarations as well).
I'm trying to get a permanent reference to two specific workbooks, but when looking at the locals window, they do not
I've tried referencing ThisWorkbook.Name as well, but it does not seem to solve the issue. It always seem to go back to referencing Workbook/ThisWorkbook.
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ThisWorkbook
sFound = Dir(ActiveWorkbook.path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
Set WB2 = ActiveWorkbook
End If
WB2.Worksheets("Sheet2").Range("A5").Copy _
WB1.Worksheets("Sheet2").Range("K18")
End Sub
I get the subscript out of range error when I run the sub.
Try This:
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ActiveWorkbook
sFound = Dir(ActiveWorkbook.Path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Set WB2 = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & sFound)
WB2.Worksheets("Sheet2").Range("A5").Copy
WB1.Worksheets("Sheet2").Range("K18").PasteSpecial xlPasteValues
End If
End Sub
Change
Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
Set WB2 = ActiveWorkbook
to
Set WB2=Workbooks.Open(ActiveWorkbook.path & "\" & sFound)
If you want a clean code : never use ActiveWorkbook !
Try this :
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ThisWorkbook
sFound = Dir(WB1.path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Set WB2 = Workbooks.Open(Filename:=WB1.path & "\" & sFound)
WB2.Worksheets("Sheet2").Range("A5").Copy _
WB1.Worksheets("Sheet2").Range("K18")
End If
End Sub