I have the below code where the user is promted to select a workbook, I want to ensure that the user is selecting a specific file, and to do this I want to verify upon opening the workbook that the Sheet names are matching what I am expecting them to be:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1
Set wb1 = ActiveWorkbook
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please a file to load from")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
If wb2.Sheet1.Name = "Sum" And wb2.Sheet2.Name = "Names" And wb2.Sheet3.Name = "Things" Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Unfortunately when I run the above code I get an "Object doesn't support this property or method error." on the line If wb2.Sheet1.Name = "Sum" And wb2.Sheet2.Name = "Names" And wb2.Sheet3.Name = "Things"
Help please!
You can use this function to check whether sheet exist or not:
Function IsSheetExist(wb As Workbook, shName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = wb.Worksheets(shName)
On Error GoTo 0
IsSheetExist = Not ws Is Nothing
End Function
and use it like this:
If IsSheetExist(wb2, "Sum") And IsSheetExist(wb2, "Names") And IsSheetExist(wb2, "Things") Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
if you want to check whether thouse sheets exist in workbook in specific order, you can use this approach:
Function IsContainsSheetsInOrder(wb As Workbook) As Boolean
IsContainsSheetsInOrder = False
If wb.Sheets.Count < 3 Then Exit Function
If wb.Sheets(1).Name <> "Sum" Then Exit Function
If wb.Sheets(2).Name <> "Names" Then Exit Function
If wb.Sheets(3).Name <> "Things" Then Exit Function
IsContainsSheetsInOrder = True
End Function
and then:
If IsContainsSheetsInOrder(wb2) Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
Or, sticking closer to his original script, change wb1.sheet#.Name to wb1.sheets(#).Name like this:
If wb2.Sheets(1).Name = "Sum" And wb2.Sheets(2).Name = "Names" And wb2.Sheets(3).Name = "Things" Then
Related
I am able to rename the activesheet using the following code but need to combine this with (first) duplicating the original sheet:
Sub CopySheet()
Dim strName As String
strName = InputBox("Budget2")
If strName = "" Then
Beep
Exit Sub
End If
ActiveSheet.Copy
ActiveSheet.Name = strName
End Sub
Per the documentation for the Worksheet.Copy method, using it without specifying either the Before or After argument will create a new Workbook, containing only that Worksheet.
So, to add a copy of the ActiveSheet after the ActiveSheet in the same Workbook, you can just change ActiveSheet.Copy to ActiveSheet.Copy After:=ActiveSheet
Make sure you check if the new sheet name already exists.
Make sure you keep track of where the copied sheet appears eg. after the source sheet SourceSheet.Copy After:=SourceSheet so you can pick up it's index which is 1 after the source sheet's: Set NewSheet = ThisWorkbook.Sheets(SourceSheet.Index + 1).
Finally make sure to catch errors on renaming if user entered not allowed characters or too long sheet names.
So you would end up with something like:
Option Explicit
Public Sub CopySheet()
Dim InputName As String
InputName = Application.InputBox("Budget2", Type:=2) '2 = text: https://learn.microsoft.com/en-us/office/vba/api/excel.application.inputbox#remarks
' user pressed cancel or entered nothing
If (VarType(InputName) = vbBoolean And InputName = False) Or InputName = vbNullString Then
Beep
Exit Sub
End If
' check if new sheet name already exists
On Error Resume Next
Dim TmpWs As Object
Set TmpWs = ThisWorkbook.Sheets(InputName)
On Error GoTo 0
If Not TmpWs Is Nothing Then
MsgBox "The Sheet '" & InputName & "' already exists", vbCritical
Exit Sub
End If
Dim SourceSheet As Object
Set SourceSheet = ActiveSheet
SourceSheet.Copy After:=SourceSheet
Dim NewSheet As Object
Set NewSheet = ThisWorkbook.Sheets(SourceSheet.Index + 1)
On Error GoTo ERR_RENAME
NewSheet.Name = "InputName"
On Error GoTo 0
Exit Sub
ERR_RENAME:
MsgBox "Sheet could not be renamed.", vbCritical
Err.Clear
End Sub
I have 2 workbooks that I run macros on "Air.xlsx" and "Ocean.xlsx", they are basically the same but for different purpose. I want to check if one of them is open , and set one of them as Wsht . I can't set them as set Wsht = activesheet because the macro starts from a different sheet.
Set Wsht = Workbooks("Air").ActiveSheet
Set Wsht = Workbooks("Ocean").ActiveSheet
an error would occur on this because i would only have one of them open.
I was suggested using below method, but i don't think it's an efficient way to do it
For Each wb In Workbooks
If wb.Name = "Air.xlsx" Then
Set PASsht = Workbooks("Air").ActiveSheet
End If
Next
Is there a way to check if Air or Ocean sheet is open and set one as Wsht?
Thanks
You can specify a sheet on whichever workbook is open. Try the code below.
Sub Test()
Dim wrksht As Worksheet
If WorkbookIsOpen("Air.xslx") Then
Set wrksht = Workbooks("Air.xlsx").Worksheets("Sheet1")
ElseIf WorkbookIsOpen("Ocean.xlsx") Then
Set wrksht = Workbooks("Ocean.xlsx").Worksheets("Sheet1")
Else
'Neither book is open, throw an error or something.
End If
End Sub
Public Function WorkbookIsOpen(FileName As String) As Boolean
Dim TestBk As Workbook
'Trying to set a reference to a closed workbook will
'throw an error - Err.Number = 0 will return TRUE or FALSE.
On Error Resume Next
Set TestBk = Workbooks(FileName)
WorkbookIsOpen = (Err.Number = 0)
On Error GoTo 0
End Function
I'm trying to figure this out. In my main sub, I call a function. Somehow it ended my run at the end of that function. It displays "Before end" and never displays "I made it out" Does anybody know what the problem is?
Sub Main()
call CopyAndDelete()
msgbox "I made it out"
End Sub
Function CopyAndDelete()
Dim CopyFromWB As Workbook
Dim CopyToWB As Workbook
Dim wb As Workbook
Dim CopyThisWS As Worksheet
Dim ws As Worksheet
Dim Path As String
Dim FileName As String
Application.DisplayAlerts = False
Set CopyToWB = Workbooks("test.xlsm")
CopyToWB.Activate
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "A"
ws.Delete
Case "B"
ws.Delete
Case "C"
ws.Delete
Case "D"
ws.Delete
End Select
Next ws
Path = Application.GetOpenFilename(Title:="choose a file")
FileName = Right(Path, Len(Path) - InStrRev(Path, "\"))
For Each wb In Workbooks
If wb.Name = FileName Then
Workbooks(FileName).Close
End If
Next wb
Set CopyFromWB = Workbooks.Open(Path)
Set CopyThisWS = CopyFromWB.Worksheets(1)
CopyThisWS.Copy After:=CopyToWB.Worksheets(1)
ActiveSheet.Name = "New A"
CopyFromWB.Close
Application.DisplayAlerts = True
MsgBox "Before end"
End Function
This works:
Sub Main()
Call CopyAndDelete
MsgBox "I made it out"
End Sub
Function CopyAndDelete()
MsgBox "Before end"
End Function
So perhaps you are closing the worksheet you were in when you called the macro? The Macro should be added to a Module and maybe it needs to be in a Module in the Normal template with the function declared as public:
Sub Main()
Call CopyAndDelete
MsgBox "I made it out"
End Sub
Public Function CopyAndDelete()
... your rest of the code ...
MsgBox "Before end"
End Function
Hth,
Public Function SetInfo(ByRef place As String, ByRef name As String) As Boolean
Dim Completed As Boolean = False
Dim MyExcel As New Excel.Application
Dim myworkbook As New Excel.Workbook
myworkbook = MyExcel.Workbooks.Open(place)
MyExcel.Workbooks.Open(place)
Dim x As Integer
Dim y As Integer
Dim finish As Boolean = False
MyExcel.Sheets("Sheet1").activate()
MyExcel.Range("B1").Activate()
Do
If MyExcel.ActiveCell.Value = name Then
Exit Do
Else
MyExcel.ActiveCell.Offset(0, 1).Activate()
End If
Loop
Do
If MyExcel.ActiveCell.Text = "" Then
MyExcel.ActiveCell.Value = "attended"
MsgBox("Wrote.")
Exit Do
Else
MyExcel.ActiveCell.Offset(1, 0).Activate()
End If
Loop
myworkbook.Save()
MyExcel.Workbooks.Close()
MyExcel = Nothing
Return finish
End Function
I will explain this code.
Start with Cell B1, and whenever the cell doesn't include what I wanted, the activate cell go right.
And if the cell is what I wanted, it goes down until program find blank space.
And in this process, there's no problem.
In saving process, it occurs problem.
If I delete these section
Dim myworkbook As New Excel.Workbook
myworkbook = MyExcel.Workbooks.Open(place)
and
myworkbook.Save()
"Something has been change, will you save it?" this Excel messagebox comes out.
And I don't want to see the messagebox and I want to save it in my program.
What should I do?
PS.Sry for my bad English.
Application.DisplayAlerts = False
myworkbook.Save()
Application.DisplayAlerts = True
Or you can use .saveAs()
msdn: http://msdn.microsoft.com/de-de/library/microsoft.office.tools.excel.workbook.saveas(v=vs.80).aspx
see: Saveas issue Overwrite existing file ( Excel VBA)
Sub Sample()
Dim fName As Object
'~~> Offer user to Save the file at a particular location
fName = Application.GetSaveAsFilename
'~~> Check if it is a valid entry
If fName <> False Then
'~~> Check before hand if the file exists
If Not Dir(fName) <> "" Then
'~~> If not then save it
ActiveWorkbook.SaveAs Filename:=fName
Else
'~~> Trap the error and ignore it
On Error Resume Next
If Err.Number = 1004 Then
On Error GoTo 0
Else '<~~ If user presses Save
ActiveWorkbook.SaveAs(Filename:=fName, _
FileFormat:=xlWorkbook, _
ConflictResolution:=xlLocalSessionChanges)
End If
End If
End If
End Sub
I was wondering if it is possible to check for a particular sheets for its availability. If it is around, it will continue on with the rest of the code. If not around then it will add in the sheet.
I have thought of it but it is giving me error. Do share some info if u know something! thanks!
sub macro1()
If sheets("Test") = False Then
Sheets.Add.Name = "Test"
End If
'Run my code
End Sub
Like this?
Sub Sample()
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets("Test")
On Error GoTo 0
If ws Is Nothing Then
Set ws = Sheets.Add
ws.Name = "Test"
End If
'~~> Run your code
End Sub
Another approach ... create a function that
- accepts a workbook object and the name of the sheet you're after and
- returns tru if the sheet is found in the workbook
Function SheetExists(oWorkbook As Workbook, sSheetname As String)
Dim oWs As Worksheet
For Each oWs In oWorkbook.Worksheets
If oWs.Name = sSheetname Then
SheetExists = True
Exit Function
End If
Next
End Function
Sub TestSheetExists()
If SheetExists(ActiveWorkbook, "Bob") Then
MsgBox "Found it"
Else
MsgBox "No joy"
End If
End Sub