I have the following question: when I use the GetFileOpenFileName option with
Multiselect = True it returns the results as a Array if I selected one file or more, but if I click "Cancel" it returns as a boolean vartype. What should I do to avoid the
error 13 "Incompatible Type
when someone clicks it.
Besides, I already tried to test if(vartype(filename) = vbBoolean) then or if(filename = False) then to exit sub, but the first one I took the same error and the second one it said that I'm not allowed to assign values to filename if I select some file.
Here is the code.
public sub open_file()
dim i as integer
Dim filename() As Variant
filename = Application.GetOpenFilename(Title:="Arquivos em Excel", MultiSelect:=True, FileFilter:="Arquivos em Excel,*.xls*")
For i = 1 To UBound(filename)
msgbox filename(i)
next i
end sub
As per comments from both #Brian M Stafford and #braX, your code should be amended as follows...
Public Sub open_file()
Dim i As Integer
Dim filename As Variant
filename = Application.GetOpenFilename(Title:="Arquivos em Excel", MultiSelect:=True, FileFilter:="Arquivos em Excel,*.xls*")
If Not IsArray(filename) Then
MsgBox "User cancelled!", vbExclamation 'optional
Exit Sub
End If
For i = 1 To UBound(filename)
MsgBox filename(i)
Next i
End Sub
To clarify, notice that filename is declared as Variant, not as an array whose elements are a Variant data type.
As such, filename can be assigned either an array containing the filenames when one or more files are selected, or a boolean value when the user cancels.
Also notice that we test whether filename is an array to determine whether the user has selected one or more files. If not, it exits the sub. Otherwise, it continues.
Related
I am trying to create a subroutine that will take a collection of a bunch of strings, step through it, and check for the existence of a named range or formula that has that string as it's name. Trying it with just one item first:
Dim colCritNames As New Collection
colCritNames.Add "Version" 'the name of a named formula
For i = 1 To colCritNames.Count
nm = CStr(colCritNames(i).Name)
nmchk = Check_UW_For_Name(nm)
If Not nmchk Then Call Fail("Critical Name") 'prints a msgbox with the error type so I know what happened
Next i
'...code for if all the names are there...
Function Check_UW_For_Name(find_name As String) As Boolean
Dim wb As Workbook
Set wb = UserFileBook 'global ref to the workbook to check
On Error Goto Fail
Check_UW_For_Name = CBool(Len(wb.Names(find_name).Name) <> 0)
On Error GoTo 0
End Function
Thats edited from the full thing. Check_UW_For_Name was working fine when I just called it with "Version" as the argument Check_UW_For_Name("Version"); it found it in USerFIleBook, and when I called it with "Nope", since there is no Nope name it went to my error handler. But when I try to use a collection to store the names I want to look for I keep getting 'ByRef argument mismatch'. I tried just nm = colCritNames(i) and nm=colCritNames(i).Name, I tried having find_name be Variant and adding a ByVal, and I originally tried having nm be a Name, having Check_UW_For_Name(find_name as Name) and using a for each (for each nm in colCritNames...) and none of it has worked.
How could I set a collection of names and step through it to see if there's a named range/formula that matches in the relevant workbook? Or is there a better way to do this? (I need the collection in other places too)
I don't quite understand what your plan is with a collection, but this will add any cell with the specified string in, as well as any ranges. What you're doing once they've been identified (added to collection) is not clear to me, but hopefully this makes sense and gets you going.
Sub RunForEachString()
Const yourStrings = "foo,bar,hope,this,works"
Dim stringsAsArray() As String
stringsAsArray = Split(yourStrings, ",")
Dim i As Long
For i = LBound(stringsAsArray) To UBound(stringsAsArray)
Call findAllNamesFormulas(stringsAsArray(i), ThisWorkbook)
Next i
End Sub
Private Sub findAllNamesFormulas(theText As String, theWorkbook As Workbook)
Dim ws As Worksheet, n As Name, aCell As Range
Dim aCollection As New Collection
For Each ws In ThisWorkbook.Worksheets
For Each aCell In ws.UsedRange.Cells
If InStr(1, aCell.Formula, theText, vbTextCompare) > 0 Then
aCollection.Add (aCell)
End If
Next aCell
Next ws
For Each n In ThisWorkbook.Names
If InStr(1, n.Name, theText, vbTextCompare) > 0 Then
aCollection.Add (n)
End If
Next n
'not sure what you plan to do after collection?
Debug.Print aCollection.Count
End Sub
This works for me:
Sub Tester()
Dim colCritNames As New Collection, nm, wb As Workbook, msg As String
colCritNames.Add "Version"
colCritNames.Add "NotThere"
colCritNames.Add "AlsoNotThere"
Set wb = ThisWorkbook 'for example
For Each nm In colCritNames
If Not Check_UW_For_Name(wb, CStr(nm)) Then
msg = msg & vbLf & " - " & nm
End If
Next nm
If Len(msg) > 0 Then
MsgBox "One or more required names are missing:" & msg, _
vbExclamation, "Oops"
Exit Sub
End If
'proceed if OK...
End Sub
'check for a defined Name `find_name` in workbook `wb`
' prefer wb as parameter over using a Global....
Function Check_UW_For_Name(wb As Workbook, find_name As String) As Boolean
On Error Resume Next
Check_UW_For_Name = (wb.Names(find_name).Name = find_name)
End Function
You could create a collection of all named ranges in the workbook like this:
Private Sub NamedRangesDemo()
Dim NamedRanges As New Collection, NamedRange As Variant
For Each NamedRange In ThisWorkbook.Names
NamedRanges.Add NamedRange.Name
Next NamedRange
End Sub
And then compare the whatever strings you want to the NamedRanges collection.
By the way, this question is somewhat similar to yours.
How can I concatenate the word "Sheet" with a number (say, 2) to form a string that can be used as the code name of a sheet.
I've tried the following piece of code but it doesn't seem to work.
Sh = "Sheet" & 2
Range("A1") = Sh.index
If you want to refer the sheet just based on index you could try something like this as well ... hope it works for you
Sub trial()
i = 2
Sheets(i).Select
End Sub
I assume you want to check if a given â–ºstring argument (CodeNameString) refers to a valid Code(Name) in the VBA project. *)
If so, the following function returns the worksheet to be set to memory; otherwise the second argument IsAvailable passed by reference will change to False and can be used for error checks (c.f. ExampleCall below).
Function SheetByCodename(ByVal CodeNameString As String, ByRef IsAvailable As Boolean) As Object
'check for same CodeName in Sheets collection
Dim ws As Object
For Each ws In ThisWorkbook.Sheets
If ws.CodeName = CodeNameString Then ' check for string identity
Set SheetByCodename = ws ' set sheet object to memory
IsAvailable = True ' assign true to 2nd argument passed ByRef
Exit For
End If
Next
End Function
Example call
Sub ExampleCall()
dim cnt As Long: cnt = 2 ' << change example counter
Dim okay As Boolean ' << needed variable passed as 2nd function argument
With SheetByCodename("Sheet" & cnt, okay)
If okay Then
Debug.Print _
"a) Worksheet Name: " & .Name & vbNewLine & _
"b) Sheet's Code(Name) in Project: " & .CodeName
Else
Debug.Print "Given string refers to no valid Code(Name)."
'do other stuff to handle the wrong input
End If
End With
End Sub
*) Take note of #RonRosenfeld 's important remarks in comment:
"Codename is assigned when the worksheet is created. It can be changed in the properties window. In order to change it programmatically, you need to enable Trust Access to the VBA object model. Otherwise, it's a read-only property. "
I am newbie in Excel. I need to something like below.
When user click on a cell or enter to cell:
It should automatically open/close file window.
When user select a file, it should pick up path/filename and put into the cell, like c:\folder1\file1.ext
If user select more than one file, it should pick up all path/filenames into cell,with | as delimiter. like c:\folder1\file1.ext|d:\folder2\file2.ext
If user click on a cell or enter to cell for a second time, it should keeps existing path/filenames and let to add other path/filnames to them like in number 3
This is similar to Sid's, just lets you double click any single cell to open the file dialog.
In a Module
Public Function getList(Optional ByVal Target As Range = Nothing) As String
Dim Dialog As FileDialog
Dim File As Integer
Dim Index As Integer
Dim List() As String
Dim Item As Integer
Dim Skip As Boolean
Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
File = Dialog.Show
If File = -1 Then
' Get a list of any pre-existing files and clear the cell
If Not Target Is Nothing Then
List = Split(Target.Value, "|")
Target.Value = ""
End If
' Loop through all selected files, checking them against any pre-existing ones to prevent duplicates
For Index = 1 To Dialog.SelectedItems.Count
Skip = False
For Item = LBound(List) To UBound(List)
If List(Item) = Dialog.SelectedItems(Index) Then
Skip = True
Exit For
End If
Next Item
If Skip = False Then
If Result = "" Then
Result = Dialog.SelectedItems(Index)
Else
Result = Result & "|" & Dialog.SelectedItems(Index)
End If
End If
Next Index
' Loop through the pre-existing files and add them to the result
For Item = UBound(List) To LBound(List) Step -1
If Not List(Item) = "" Then
If Result = "" Then
Result = List(Item)
Else
Result = List(Item) & "|" & Result
End If
End If
Next Item
Set Dialog = Nothing
' Set the target output if specified
If Not Target Is Nothing Then
Target.Value = Result
End If
' Return the string result
getList = Result
End If
End Function
In Your Worksheet's Code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then getList Target
End Sub
Update
I've changed the getList function (it wasn't broken, just made it do more)
It will allow you to double click any cell, which will open a file dialog.
You can select 1 (or more) files
The file names will be joined with the "|" character and put in the target cell
If any pre-existing files are in the cell, the new ones will be appended to them
It does not however support pressing enter to open the file dialog, you must double-click the cell.
Update
To help VMO (commenter)
The code in the worksheet module:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
If Target.Address = "$A$1" Then ' See Notes Below
Target.Value = getList(Target)
End If
End If
End Sub
To restrict what cell(s) are double-click'able you will need to use something like that. You can change $A$1 to whatever you want or find a way to determine the target range's name (not too difficult)
If your worksheet is not locked the cell that is clicked will keep focus, and be in edit-mode which is a little annoying. Locking the cell, in previous versions of excel fixed this (i think it doesn't work in v.2010+ though)
The code in the module (getList) can remain almost exactly the same (although you might want to remove all the code that deals with multiple files, not required though). All you need to do is add one line of code.
.......
Dim Skip As Boolean
Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
Dialog.AllowMultiSelect = False ' This will restrict the dialogue to a single result
File = Dialog.Show
If File = -1 Then
......
Hope this helps and I've understood what you were asking!
This should do the trick. The first subroutine is the event that is triggered on the user clicking on a cell. Change the row and column numbers in the first if statement to change the target cell. You can put all of this code in the code module for the worksheet you want it to work on.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim filenames() As String
Dim filename As Variant
Dim filelist As String
' Make sure the user clicked our target cell
If Target.Row = 2 And Target.Column = 2 Then
' Get a list of filenames
filenames = GetFileNames
' Make sure we got some filenames
If UBound(filenames) > 0 Then
' Go through the filenames, adding each to the output string
For Each filename In filenames
filelist = filelist & CStr(filename) & "|"
Next filename
' Remove the final delimiter
filelist = Left(filelist, Len(filelist) - 2)
' Apply the output string to the target cell (adding another
' delimiter if there is already text in there)
If Not Target.Value = "" Then
Target.Value = Target.Value & "|"
End If
Target.Value = Target.Value & filelist
End If
End If
End Sub
The following function is that which is called to open the file dialogue and retrieve the filenames.
Private Function GetFileNames() As String()
Dim dlg As FileDialog
Dim filenames() As String
Dim i As Integer
' Open a file dialogue
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.ButtonName = "Select" ' Text of select/open button
.AllowMultiSelect = True ' Allows more than one file to be selected
.Filters.Add "All Files", "*.*", 1 ' File filter
.Title = "Select file(s)" ' Title of dialogue
.InitialView = msoFileDialogViewDetails
.Show
' Redimension the array with the required number of filenames
ReDim filenames(.SelectedItems.Count)
' Add each retrieved filename to the array
For i = 1 To .SelectedItems.Count
filenames(i - 1) = .SelectedItems(i)
Next i
End With
' Clean up and return the array
Set dlg = Nothing
GetFileNames = filenames
End Function
I have a dynamically defined named range in my excel ss that grabs data out of a table based on a start date and an end date like this
=OFFSET(Time!$A$1,IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),1,MATCH(Date_Range_End,AllDates)-IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),4)
But if the date range has no data in the table, the range doesn't exists (or something, idk). How can I write code in VBA to test if this range exists or not?
I have tried something like
If Not Range("DateRangeData") Is Nothing Then
but I get "Runtime error 1004, method 'Range' of object '_Global' failed."
Here is a function I knocked up to return whether a named range exists. It might help you out.
Function RangeExists(R As String) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = ActiveSheet.Range(R)
RangeExists = Err.Number = 0
End Function
You can replicate the match in your VBA to count before using the range how many rows you would have, or you can use error handling:
On Error Resume Next
Debug.Print range("DateRangeData").Rows.Count
If Err = 1004 Then
MsgBox "Range Empty"
Exit Sub
Else
MsgBox "Range full"
End If
Err.Clear
On Error GoTo 0
This is another approach. It has the advantage to take the container and the name you want to test. That means you can test either Sheets Names or Workbook Names for example.
Like this:
If NamedRangeExists(ActiveSheet.Names, "Date") Then
...
Else
...
End If
or
If NamedRangeExists(ActiveWorkbook.Names, "Date") Then
...
Else
...
End If
Public Function NamedRangeExists(ByRef Container As Object, item As String) As Boolean
Dim obj As Object
Dim value As Variant
On Error GoTo NamedRangeExistsError:
value = Container(item)
If Not InStr(1, CStr(value), "#REF!") > 0 Then
NamedRangeExists = True
End If
Exit Function
Exit Function
NamedRangeExistsError:
NamedRangeExists = False
End Function
Depending on the application you're doing, it's good to consider using a Dictionary. They're especially useful when you wanna check whether something exists.
Take this example:
Dim dictNames as Scripting.Dictionary
Sub CheckRangeWithDictionary()
Dim nm As Name
'Initially, check whether names dictionary has already been created
If Not dictNames Is Nothing Then
'if so, dictNames is set to nothing
Set dictNames = Nothing
End If
'Set to new dictionary and set compare mode to text
Set dictNames = New Scripting.Dictionary
dictNames.CompareMode = TextCompare
'For each Named Range
For Each nm In ThisWorkbook.Names
'Check if it refers to an existing cell (bad references point to "#REF!" errors)
If Not (Strings.Right(nm.RefersTo, 5) = "#REF!") Then
'Only in that case, create a Dictionary entry
'The key will be the name of the range and the item will be the address, worksheet included
dictNames(nm.Name) = nm.RefersTo
End If
Next
'You now have a dictionary of valid named ranges that can be checked
End Sub
Within your main procedure, all you need to do is do an existence check before using the range
Sub CopyRange_MyRange()
CheckRangeWithDictionary
If dictNames.exists("MyRange") then
Sheets(1).Range("MyRange").Copy
end if
End Sub
While loading the dictionary may look a little longer, it's extremely fast to process and search. It also becomes much simpler to check whether any named range referring to a valid address exists, without using error handlers in this simple application.
Please note that when using names at sheet level rather than workbook level, it is necessary to use more elaborate keys to guarantee uniqueness. From the way the dictionary was created, if a key is repeated, the item value is overwritten. That can be avoided by using the same Exists method as a check in the key creation statement. If you need a good reference on how to use dictionaries, use this one.
Good luck!
This is an old post, but none of the rated answers has a dynamic solution to test if a name exists in a workbook or worksheet. This function below will accomplish that:
Function pg_Any_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
pg_Any_Name = True
Exit Function
End If
Next n
End Function
Worth noting that this would not have worked for this specific question because OP had a dynamic defined range. This question would have been more accurately titled Test if Name is a Valid Range because the name always existed as a formula, the issue was if it was a valid RANGE. To address this question with a solution that checks both workbook and sheets... this function would work:
Function PG_Range_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
On Error Resume Next
PG_Range_Name = n.RefersToRange.Columns.Count > 0
Exit Function
End If
Next n
End Function
I found this function on a web
Private Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString then
FileFolderExists = True
End If
EarlyExit:
On Error GoTo 0
End Function
And I want to pass string variable like this
Dim lineText As String
...
ElseIf FileFolderExists(lineText) = False Then
I am getting compile error "byref argument type mismatch"
When I put byval before strFullPath, it doesn't seem to work properly.
I also tried playing with Dir function, it works if I pass literal like "C:\test", but it doesn't work if I pass the variable.
Does anyone have function that check for folder existence and accepts the string variable as parameter ?
Thanks in advance
The problem seems to be that Word adds CR character to every paragraph, or, to be more exact, that the Text property of the Paragraph object returns the paragraph text plus the CR character.
AFAIK, this is the Word's behaviour for every paragraph, even for the last one.
How can this cause a compile error, I do not have a clue. If I take Milan's example:
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).Range.Text
lineText = Left(lineText, Len(lineText) - 1) 'see below
MsgBox DoesFolderExist("C:\")
MsgBox DoesFolderExist(lineText)
End Sub
it returns true, true if the first line of the document is a valid folder. If I comment the marked line, the program still compiles and runs and returns true, false (with the same document).
There is some info about it on MSDN website
Try this:
Function FolderExists(folderPath As String) As Boolean
Dim f As Object
Set f = CreateObject("Scripting.FileSystemObject")
On Error GoTo NotFound
Dim ff As Object
Set ff = f.GetFolder(folderPath)
FolderExists = True
Exit Function
NotFound:
FolderExists = False
On Error GoTo 0
End Function
I used the following to test it:
Sub Tst()
Dim b As Boolean
Dim s As String
s = "c:\temp"
b = FolderExists(s)
End Sub
And it works as expected.
Generally, I used Scripting.FileSystemObject for all file-related operation in VBA, the native functions are too cumbersome.
It should be also noted that my function all checks for folders, while the original function -- judging by its name -- perhaps also tried to check for existence of files.
New code, it explains exactly what I need, it should be easier for you to try.
I am expecting folder in first line of the Word document, then I have to check if it exists.
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).range.Text
MsgBox DoesFolderExists("C:\") ' this works
MsgBox DoesFolderExists(lineText) ' this doesnt work, when same folder passed
End Sub
Both my and Martin's function are throwing compiling error I wrote in my first post.
If it matters : Word is 2010, "option explicit" isn't written (I inherited the code, I can't change that)