I put together a sub that allows you to input the name of the file you want your sub to refer to instead of encoding a single file. However beyond the input box, I get the error "subscript out of range". I tried entering the file name with and without "" and file extension .xls
Sub tester()
Dim wbName As String
wbName = Application.InputBox("What is the workbook name?")
If Right(wbName, 4) <> ".xls" Then wbName = wbName + ".xls"
Set mainWB = Workbooks(wbName)
Dim copyThis As Range, pasteThis As Range
Set copyThis = mainWB.Worksheets(2).Columns("F")
Set pasteThis = Workbooks("VBA Workbook.xlsm").Worksheeets(1).Columns("A")
copyThis.Copy Destination:=pasteThis
End Sub
Whenever there is user intervention, you will have to use lot of error handling to avoid possible errors. I recommned using a Userform insetad. Instead of the making a user, type the workbook name, use a UserForm witm a ComboBox1 (As shown in the image below) populated with the names of all open workbooks so that user can choose the relevant workbook rather than typing the name
Code
Option Explicit
Private Sub UserForm_Initialize()
Dim wkb As Workbook
Me.Label1.Caption = "Please select the relevant workbook"
With Me.ComboBox1
'~~> Loop thorugh all open workbooks and add
'~~> their name to the Combobox
For Each wkb In Application.Workbooks
.AddItem wkb.Name
Next wkb
End With
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.ListIndex = -1 Then
MsgBox "Please select a wotkbook name and try again"
Exit Sub
End If
Dim wb As Workbook
Set wb = Workbooks(ComboBox1.List(ComboBox1.ListIndex))
With wb
MsgBox .FullName
'~~> Do what you want
End With
End Sub
Related
I'm attempting to have a user select a file, then through a UserForm select the worksheet they want to copy from.
The issue is on this line: ReportWbk.Sheets(ws).Cells.Copy Destination:=TargetWbk.Sheets("Test Import").Cells(1, 1)
I have confirmed that the file, worksheet selection, and copy function all work as expected. I get a run-time error '9': Subscript out of range. which to me means that the code is looking for the destination sheet in the workbook that the user selected (the 'target' file). Since it doesn't exist there, it errors out.
I'm wondering how to fix this dynamically so that the code will work without naming the workbook specifically. I might run this with other workbooks open and in different workbooks.
I verified that workbooks("WorkbookName").Sheets("Test Import").Cells(1, 1) works as I want but I'm looking to make the "WorkbookName" part dynamic / automatically select the workbook that the macro was run from.
The main code is directly below and the userform code is below that in case that's part of the issue:
Private Sub GetRange()
Dim ReportWbk As Workbook 'workbook with report data
Dim Report As Integer 'name of file with report data
Dim FD As FileDialog
Dim TargetWbk As Workbook 'this workbook
Dim ws As Variant
Set TargetWbk = ThisWorkbook
Set FD = Application.FileDialog(msoFileDialogFilePicker)
Report = FD.Show
'cancel pressed
If Report <> -1 Then Exit Sub
'open selected workbook
Set ReportWbk = Workbooks.Open(FD.SelectedItems(1))
ws = SelectSheet.Selection(ReportWbk)
'cancel pressed
If ws = vbCancel Then GoTo exitsub
ReportWbk.Sheets(ws).Cells.Copy Destination:=TargetWbk.Sheets("Test Import").Cells(1, 1)
exitsub:
ReportWbk.Close False
'changes the color of the destination worksheet tab
Worksheets("Test Import").Tab.Color = RGB(25, 25, 25)
End Sub
UserForm Code:
Private Sub cmdOK_Click()
Me.Tag = Me.ListBox1.Value
Me.Hide
End Sub
Private Sub cmdCancel_Click()
Me.Tag = vbCancel
Me.Hide
End Sub
Function Selection(ByVal wb As Object) As Variant
Dim ws As Worksheet
For Each ws In wb.Worksheets
'add all sheets to listbox
Me.ListBox1.AddItem ws.Name
Next ws
'default - select first sheet in list
With Me.ListBox1
.ListIndex = 0
.MultiSelect = fmMultiSelectSingle
End With
Me.Show
'return result
Selection = Me.Tag
Unload Me
End Function
Private Sub UserForm_Initialize()
Me.Caption = "Select Sheet"
Me.CmdOK.Caption = "OK"
Me.cmdCancel.Caption = "Cancel"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'disable X closing form
Cancel = CBool(CloseMode = 0)
If Cancel = -1 Then Me.Tag = vbCancel: Me.Hide
End Sub
I know this is a simple thing but I've been away from VBA for a few years and rusty as heck. Many thanks in advance!
Amateur Coder here.
Currently, I have this Macro linked via button. The goal is the following:
A. Once button is pressed, prompts users to select an excel workbook to Import data to, I have the following code for this part:
Sub select_file()
Dim FileSelect As FileDialog
Dim PathA As String
Set FileSelect = Application.FileDialog(msoFileDialogFilePicker)
With FileSelect
.Title = "Please Select the Doc you want to import Data to"
.AllowMultiSelect = False
.ButtonName = "Confirm"
If .Show = -1 Then
PathA = .SelectedItems(1)
Else
End
End If
End With
Workbooks.Open Filename:=PathA
End Sub
B. Once selected, begins to copy and paste data in an absolute manner/HardCoded. (I know its discouraged, but cell will not change ever) OR hard write the following formula into the destination cell. Please Assume F26 is from the destination document.
=IF(F26='[source.xlsm]Sheet1'!E10,'[Source.xlsm]Sheet1'!G10,"#REF")
How do I make Part B occur without recording it as a macro? Better yet, how do I make it plop that data into the destination?
Edit 1: The paste portion is me using the if function for verification.
If you insist on making the user identify the correct workbook/worksheet, then you can try something like this:
Sub Main_Sub()
Dim SourceWB As Workbook
Set SourceWB = ManualSelectWorkbook
' >>> Following line are only to demonstrate
' selected workbook is saved as "SourceWB"
Debug.Print SourceWB.Sheets(1).Range("A1").Value
SourceWB.Activate
End Sub
Function ManualSelectWorkbook() As Workbook
' > Variables
Dim WB As Workbook 'Possible Destination Workbook
Dim Dict As Object 'Dictionary of workbook names
Dim PromptText As String 'Inputbox Text Prompt
Dim WBselected As Integer 'Index number of selected workbook
Dim I As Integer 'Iterations
' > Variable Prep
I = 1
PromptText = ""
Set Dict = CreateObject("Scripting.Dictionary")
' > Store names of each open workbook
For Each WB In Application.Workbooks
Dict.Add I, WB.Name
PromptText = PromptText & "#" & I & " = " & WB.Name & vbCrLf
I = I + 1
Next WB
' > Ask user which workbook they wish to use
WBselected = InputBox("Please indicate which workbook you would like this data copied to:" & vbCrLf & vbCrLf & _
PromptText & vbCrLf & _
"Must be integer.", "Workbook Selection", "1")
' > Set Function = selected workbook
'Debug.Print Dict(WBselected)
Set ManualSelectWorkbook = Workbooks(Dict(WBselected))
' > Clear dictionary
Dict.RemoveAll
End Function
You can even do the exact same thing inside the selected workbook to identify the correct worksheet.
-
On the otherhand, if you know the partial name of the output workbook, you can use something like this:
Sub ExampleSub()
'Sub to initiate function
AlternateEnding.Activate
End Sub
Function AlternateEnding() As Workbook
Dim WB As Workbook
For Each WB In Application.Workbooks
If WB.Name Like "*Insert partial workbook name*" Then '<<< Must Leave asterixes.
AlternateEnding = WB
Exit Function
End If
Next WB
End Function
Is there a way to specify a workbook for a sheet without having the full name?
For example, If the workbook name is MyWorbook2015 and the 2015 may change to 2016 in the future, I need to to recognize the workbook based on MyWorkbook, and ignore the 2015. Something similar to this:
With Workbooks("MyWorkbook2015").Sheets("My_Sheet_Name_That_Does_Not_Change")
'do something
End With
In the code sample above, I need it to recognize the work book regardless of the date? Is this possible? If it is, how would I go about doing that?
Yes you can use the LIKE Operator with a wildcard "*". Here is an example. I am assuming that the workbook is open.
Sub Sample()
Dim wb As Workbook
Dim wbName As String
'~~> "MyWorkbook2015"
wbName = "MyWorkbook"
For Each wb In Application.Workbooks
If wb.Name Like wbName & "*" Then
Debug.Print wb.Name
With wb.Sheets("My_Sheet_Name_That_Does_Not_Change")
'~~> Do something
End With
End If
Next wb
End Sub
EDIT
Here is a way where you can use it as a function
Dim wbName As String
Sub Sample()
'~~> "MyWorkbook2015"
wbName = "MyWorkbook"
If Not GetWB Is Nothing Then
Debug.Print GetWB.Name
With GetWB.Sheets("My_Sheet_Name_That_Does_Not_Change")
'~~> Do something
End With
Else
MsgBox "No workbook with that name found"
End If
End Sub
Function GetWB() As Workbook
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name Like wbName & "*" Then
Set GetWB = wb
Exit Function
End If
Next wb
End Function
A slightly more reliable alternative to doing a partial match on Workbook.Name is to do an equivalency match on WorkBook.CodeName. The default CodeName for a Workbook is "ThisWorkbook", but you can change that by selecting the "ThisWorkbook" code page in the Project Explorer window and then open the Properties Window (Key: F4) and change the Name property for the code page.
Then following the example that Siddharth has shown but redefining then "GetWB" function like this:
Function GetWB() As Excel.Workbook
Const wbCodeName As String = "MySecretWorkbookName" ' change to the CodeName you choose
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.CodeName = wbCodeName Then
Set FindWorkbook = wb
Exit For
End If
Next wb
End Function
Note that changing the CodeName allows you to use the new CodeName in places where you would have used "ThisWorkbook", but you can still use "ThisWorkbook" as well.
I have multiple workbooks with worksheet named 'SUMMARY-F'. I need to combine these worksheets into one workbook and I am using the below code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
The code worked perfectly about 4 times however now when I run it, I get a subscript out of range error 9. Any tips on how to fix this?
Thanks,
Lucinda
If you have a workbook that is open that doesn't contain a sheet called SUMMARY-F you'll get an out-of-range error because Excel can't find a sheet with the specified name. This error will also apply to hidden workbooks such as a PERSONAL.xlsm if you've used it to record macros.
You should include a check in your code to handle the case when an open workbook doesn't have a sheet called SUMMARY-F.
See this question that gives options on how to identify if a sheet exists, such as defining a function that could be called from your code first:
How to check whether certain sheets exist or not in Excel-VBA?
You'll just need to modify it to check a sheet in another workbook, something like:
Public Function CheckSheet(ByVal sWB As String, ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In Workbooks(sWB).Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Then you can add a check in your code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
If CheckSheet(wkb.Name,sWksName)
wkb.Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
Set wkb = Nothing
End Sub
A "Runtime Error 9, Subscript Out of Range" is received on the Set wb1 line. This similar structure runs fine in a different workbook without error.
My goal is to copy a cell from the Source document into te Destination document.
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = Workbooks("C:\Test\DST.xlsm")
Set wb1 = Workbooks.Open("C:\Test\Source.xlsx")
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
If DST.xlsm is open already then
Set wb = Workbooks("DST.xlsm")
ElseIf you need to open DST.xlsm
Set wb1 = Workbooks.Open("C:\Test\DST.xlsm")
for a more robust approach to workbooks handling you may want to use the following GetOrSetWorkbook() function:
Option Explicit
Function GetOrSetWorkbook(wbName As String) As Workbook
On Error Resume Next
Set GetOrSetWorkbook = Workbooks(GetNameOnly(wbName)) '<--| check if a workbook with given name is already open
If GetOrSetWorkbook Is Nothing Then Set GetOrSetWorkbook = Workbooks.Open(wbName) '<--| if no workbook open with given name then try opening it with full given path
End Function
which uses the following helper GetNameOnly() function:
Function GetNameOnly(pathStrng As String) As String
Dim iSlash As Long
iSlash = InStrRev(pathStrng, "\")
If iSlash > 0 Then
GetNameOnly = Mid(pathStrng, iSlash + 1, Len(pathStrng))
Else
GetNameOnly = pathStrng
End If
End Function
so that a possible use of it could be:
Option Explicit
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = GetOrSetWorkbook("C:\Test\DST.xlsm") '<--| try getting "C:\Test\DST.xlsm"
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle C:\Test\DST.xlsm workbook error, like:
MsgBox "Couldn't find 'C:\Test\DST.xlsm' !", vbCritical + vbOKOnly
End If
Set wb1 = GetOrSetWorkbook("C:\Test\Source.xlsx") '<--| try getting "C:\Test\Source.xlsx
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle 'C:\Test\Source.xlsx' workbook error, like:
MsgBox "Couldn't find 'C:\Test\Source.xlsx'!", vbCritical + vbOKOnly
End If
'here goes rest of the code to be executed once all necessary workbooks have been properly set
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
of course a very similar GetOrSet approach can be assumed with worksheets, too...