Code is running well while checking if "Test_Worksheet" worksheet exists in workbook file opened by dialog. Workbook File is opening correctly & if "Test_Worksheet" sheet exists in that file then debug.print (in Sub ChkSalfile) give "Name is True".
But if sheet not available in Workbook, then "Subscription out of Range" error coming. Please help. My code is as below
Sub Main()
Dim salefor As Workbook
Dim salpathfileName As String, salfileName As String
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select file."
.Filters.Clear
.Filters.Add "Excel 2003", "*.xls?"
.InitialFileName = "*SAL*.*"
result4 = .Show
If (result4 <> 0) Then
salfileName = Dir(.SelectedItems(1))
salpathfileName = .SelectedItems(1)
Else
'if user pressed CANCEL - exit sub
Application.ScreenUpdating = True
MsgBox "User pressed CANCEL"
Exit Sub
End If
End With
Set salefor = Workbooks.Open(salfileName, ReadOnly:=True)
Call ChkSalfile(salfileName, salefor)
End Sub
Sub ChkSalfile (salfileName As String, salefor As Workbook)
Dim chksalsheet As String
chksalsheet = DoesWorkSheetExist("Test_Worksheet", salfileName)
If chksalsheet = True Then
Debug.Print "Name is " & chksalsheet
Else
Debug.Print "File not found"
End If
End Sub
Option Explicit
Public Function DoesWorkSheetExist(WorkSheetName As String, Optional WorkBookName As String)
Dim WS As Worksheet
On Error Resume Next
If WorkBookName = vbNullString Then
Set WS = Sheets(WorkSheetName)
Else
Set WS = Workbooks(WorkBookName).Sheets(WorkSheetName)
End If
On Error GoTo 0
DoesWorkSheetExist = Not WS Is Nothing
End Function
It seems that your settings in the VBA project editor are set to break on any errors. Change this setting to break only on unhandled errors:
Tools --> Options --> General Tab --> Error Trapping --> check "Break on Unhadled Errors"
That said, don't Dim your variable as a String when it is a Boolean:
Dim chksalsheet As Boolean ' <-- Not as String
Related
I'm trying to use below code to selecting a file and write it's path and filename to textbox. I tried from a Worksheet with codename TESTAREA But i'm always get an error Type Mismatch.
I'm using below procedure to use function from sheet TEST_AREA(TESTAREA) Sheet Name (Code Name)
Private Sub CommandButton1_Click()
Call myFunctions.SelectFile(TESTAREA, "*.txt", TextBox1)
End Sub
This is function
Function SelectFile(ByVal strSheetName As Worksheet, strFilterExt As String, strTextBox As TextBox)
Dim fdo As Office.FileDialog
Set fdo = Application.FileDialog(msoFileDialogFilePicker)
With fdo
.InitialFileName = AUTOMBS.path
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "All Files", strFilterExt
If .Show = True Then
strSheetName.strTextBox.Value = .SelectedItems(1)
End If
End With
End Function
Could you please help me where i'm wrong ?
This worked for me. I added an ActiveX TextBox to Sheet1 and used your code. It gave me a Type Mismatch until I changed the function to take a MSForms.TextBox instead.
Sub Test()
Debug.Print GetName(Sheet1.TextBox1)
End Sub
Function GetName(tb As MSForms.TextBox)
GetName = tb.Value
End Function
So try this. I changed it to a Sub because you aren't returning anything to the Function!
Sub SelectFile(ByVal strSheetName As Worksheet, strFilterExt As String, strTextBox As MSForms.TextBox)
Dim fdo As Office.FileDialog
Set fdo = Application.FileDialog(msoFileDialogFilePicker)
With fdo
.InitialFileName = AUTOMBS.path
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "All Files", strFilterExt
If .Show = True Then
strTextBox.Value = .SelectedItems(1)
End If
End With
End Sub
I have written this sort of code in VBA:
Sub itemselecter()
Dim Filename1 As String
Dim Sourcewb1 As Workbook
Dim Targetwb1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show = 0 Then
Exit Sub
Else
Filename1 = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End If
End With
Application.ScreenUpdating = False
Set Sourcewb1 = Workbooks.Open(Filename1) 'Open FIC data
Set Targetwb1 = ThisWorkbook
Targetwb1.Worksheets("Data").ClearContents
Sourcewb1.Worksheets(1).Cells.Copy Destination:=Targetwb.Sheets("Data").Cells
Sourcewb1.Close (False)
Application.ScreenUpdating = True
End Sub
It gives me at the moment error 424, while trying to select the file from documents. What is wrong?
Try the code below, check for comments inside the code where I've made modifications.
If you would have added Option Explicit at the top of your code, then the second error wouldn't have occurred (where you mixed-up Targetwb with Targetwb1).
Code
Option Explicit
Sub itemselecter()
Dim Filename1 As String
Dim Sourcewb1 As Workbook
Dim Targetwb1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show = 0 Then
Exit Sub
Else
Filename1 = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End If
End With
Application.ScreenUpdating = False
Set Sourcewb1 = Workbooks.Open(Filename1) 'Open FIC data
Set Targetwb1 = ThisWorkbook
Targetwb1.Worksheets("Data").Cells.ClearContents '<-- added .Cells to clear the worksheet's entire cells contents
Sourcewb1.Worksheets(1).Cells.Copy Destination:=Targetwb1.Sheets("Data").Cells '<-- need to be Targetwb1 not Targetwb
Sourcewb1.Close (False)
Application.ScreenUpdating = True
End Sub
Kindly change this line of code,
Targetwb1.Worksheets("Data").ClearContents
into something like
Targetwb1.Sheets("Data").Cells.ClearContents
Please let me suggest you to check if the sheet "Data" exists in that workbook.
I am currently using to following code to prompt the user for a workbook, open it, get some information from it and then close it. at the moment, I address the opened workbook by using the workbooks collection with and index ("woorkbooks(2)"). Now I need to open two workbooks, and my problem is that I wouldn't know which of the workbooks will be indexed as 2 and which will be indexed as 3. So, I figured there must be a way to get a reference to each workbook.
Function openfile() As Boolean
Dim fd As FileDialog
Dim file_was_chosen As Boolean
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Filters.Clear
.Filters.Add "Excel File", "*.xl*"
End With
file_was_chosen = fd.Show
If Not file_was_chosen Then
MsgBox "You didn't select a file"
openfile = False
Exit Function
End If
fd.Execute
openfile = True
End Function
Now I've seen some solutions to this problem involving getting the full path of each workbook, but I'd prefer avoid using the full path since it contains words in different language (and the name of the workbook appears with question marks). Moreover, I'd prefer a solution in which the user is promped only once for 2 files and not twice.
This version gives the user a single dialog. Enjoy. And whoever downvoted my other answer, please add a comment to that explaining what you so disliked about it that it required a downvote.
Function openfile() As Variant
Dim aOpen(2) As String, itm As Variant, cnt As Long, lAsk As Long
Dim fd As FileDialog
Dim file_was_chosen As Boolean
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Filters.Clear
.Filters.Add "Excel File", "*.xl*"
End With
Do
file_was_chosen = fd.Show
If Not file_was_chosen Or fd.SelectedItems.Count > 2 Then
lAsk = MsgBox("You didn't select one or two files, try again?", vbQuestion + vbYesNo, "File count mismatch")
If lAsk = vbNo Then
openfile = aOpen
Exit Function
End If
End If
Loop While fd.SelectedItems.Count < 1 Or fd.SelectedItems.Count > 2
cnt = 0
For Each itm In fd.SelectedItems
aOpen(cnt) = itm
cnt = cnt + 1
Next
openfile = aOpen
fd.Execute
End Function
Sub test()
Dim vRslt As Variant
Dim wkb As Excel.Workbook, wkb1 As Excel.Workbook, wkb2 As Excel.Workbook
vRslt = openfile
For Each wkb In Application.Workbooks
If wkb.Path & "\" & wkb.Name = vRslt(0) Then Set wkb1 = wkb
If wkb.Path & "\" & wkb.Name = vRslt(1) Then Set wkb2 = wkb
Next
If vRslt(0) = "" Then ' no files
MsgBox "No files opened so nothing happens..."
ElseIf vRslt(1) = "" Then ' one file was opened
MsgBox "One file so do whatever you want for one file"
Else ' two files were opened
MsgBox "Two files so do whatever you want for two files"
End If
End Sub
Working with your existing openfile function, change the return from Boolean to Excel.Workbook. If they don't open a workbook you set it to Nothing instead of false, otherwise you set it to the workbook reference of the file you just opened (You'll need to modify openfile to get that reference). You then just call it twice and set a workbook reference for each call that is not Nothing.
Example code below is written freeform and is untested - it's really just glorified pseudocode - but should point you the right general direction.
sub test
dim lAsk as long
dim wkb1 as excel.workbook
dim wkb2 as excel.workbook
do
if wkb1 is Nothing then
set wkb1 = openfile
if wkb1 is Nothing then
lAsk = msgbox("you didn't select a first file, try again?",vbyesno,"No file selected")
if lAsk = vbNo then exit do
end if
elseif wkb2 is Nothing then
set wkb2 = openfile
if wkb2 is Nothing then
lAsk = msgbox("you didn't select a second file, try again?",vbyesno,"No file selected")
if lAsk = vbNo then exit do
end if
end if
loop while wkb1 is Nothing or wkb2 is Nothing
' do whatever with wkb1 and wkb2 here
end sub
Edited to add:
Here's a very basic shape for your revised openfile function. Again, untested but I've modified it from one of my own procs so it should work
Function openfile() As Excel.Workbook
Dim sFilter As String
Dim sTitle As String
Dim vFileName As Variant
sFilter = "Excel Files (*.xl*), *.xl*, CSV Files (*.csv), *.csv, All Files (*.*), *.*"
sTitle = "Select file to process"
vFileName = Application.GetOpenFilename(filefilter:=sFilter, Title:=sTitle)
If vFileName = False Then
Set openfile = Nothing
Else
Set openfile = Workbooks.Open(Filename:=vFileName)
End If
End Function
Worksheets("Hello").Move After:=Workbooks("FILE2").Sheets(1)
I have two open active files. Hello.xlsb and FILE2.xlsb
The above code only works on my computer but not on shared drive.
I am getting "Subscript out of range error".
We need to specify the extension FILE2.xlsb to make it work.
However, I want this to work on any FILE2 with any extension.
How to make that work?
This code will ask you to open the destination workbook and move the sheet into it, is it what you're after?
Public Sub Test()
Dim vfile As Variant
Dim wrkBk As Workbook
'Ask for the location of File2.
vfile = GetFile(ThisWorkbook.Path)
Set wrkBk = Workbooks.Open(vfile)
ThisWorkbook.Worksheets("Hello").Move After:=wrkBk.Worksheets(1)
End Sub
Function GetFile(Optional startFolder As Variant = -1) As Variant
Dim fle As FileDialog
Dim vItem As Variant
Set fle = Application.FileDialog(msoFileDialogFilePicker)
With fle
.Title = "Select a File"
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xls*", 1
If startFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function
If your destination workbook is already open, then you can use this to safely refer to a workbook regardless of extension:
Function GetWb(wbName As String)
Dim wb As Workbook, rv As Workbook
For Each wb In Application.Workbooks
If UCase(wb.Name) Like UCase(wbName & ".*") Then
Set rv = wb
Exit For
End If
Next wb
Set GetWb = rv
End Function
Usage
Dim destWb As Workbook
Set destWb = GetWb("file2")
if destWb Is Nothing then
Msgbox "destination file not open!"
else
'perform the copy
end if
FYI this may be why you see differences between computers:
Windows().Activate works on every computer except one
I have a Macro, that prompts a user to select an Excel file, like this:
Dim thisBook As Workbook, newBook As Workbook
Dim fd As FileDialog
Dim oFD As Variant
Dim fileName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.ButtonName = "Select"
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xls", 1
.Title = "Choose the Report"
.InitialView = msoFileDialogViewDetails
.Show
For Each oFD In .SelectedItems
fileName = oFD
Next oFD
On Error GoTo 0
End With
If fd.SelectedItems.Count = 0 Then
Exit Sub
End If
Set thisBook = ActiveWorkbook
Set newBook = Workbooks.Open(fileName)
This works fine, what I want to do now, and what I failed to find in the internet is the following:
I want to prompt the user to select a worksheet from the newbook, since the sheet name could not be the same in the future.
I came up with this, but I am not very happy with it, since it is rather inconvenient, to let the user type the sheet name:
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Function q() As String
Dim shname As String
Do Until WorksheetExists(shname)
shname = InputBox("Enter sheet name")
If Not WorksheetExists(shname) Then MsgBox shname & " doesn't exist!", vbExclamation
Loop
q = shname
End Sub
Is there a way, to maybe let the user select the sheet name, from all the sheet names? (I am not using an Userform, the Macro starts, if the user clicks a Button)
Make a userform with a blank ListBox and use this code in the userform module
Private Sub UserForm_Initialize()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Sheets
ListBox1.AddItem sh.Name
Next sh
End Sub
Private Sub ListBox1_Click()
Sheets(ListBox1.Value).Activate
Unload Me
End Sub
Use an InputBox and have the user select any cell inside the desired/target sheet. Setting the type to 8 returns a Range. From this range, you can get the worksheet then its name.
Dim desiredSheetName as String
desiredSheetName = Application.InputBox("Select any cell inside the target sheet: ", "Prompt for selecting target sheet name", Type:=8).Worksheet.Name
Debug.Print desiredSheetName