My code is fairly simple but a bit puzzling. I might be committing a minor error - pardon my newbie-ness. The Sheets.Add.Name line still gets executed despite having Boolean = True, thus a new worksheet is created with the Sheet# naming convention.
Sharing my code:
Private Sub create_analyst_btn_Click()
Dim strUser As String
Dim DateToday As String
Dim ws As Worksheet
Dim boolFound As Boolean
strUser = newanalyst_form.user_User.Value
For Each ws In Worksheets
If ws.Name Like strUser Then boolFound = True: Exit For
Next
If boolFound = True Then
MsgBox ("User already exists.")
Else
DateToday = Format(Date, "-yyyy-mm-dd")
Sheets.Add.Name = strUser & DateToday
Unload Me
End If
End Sub
I don't see the point of the first If statement and I would refactor your code to the following:
For Each ws In Worksheets
If ws.Name Like "*" & strUser & "*" Then
MsgBox ("User already exists.")
Exit For
Else
DateToday = Format(Date, "-yyyy-mm-dd")
Sheets.Add.Name = strUser & DateToday
Unload Me
End If
Next ws
The logic here is that if the name already exists before calling the subroutine, we would discover this while iterating, display a warning message in an alert box, and exit. Otherwise, the name/date would be added to the sheet.
Related
Forgive my noob-ery. Assistance greatly appreciated!!!!
Purpose of macro: Fill in form in Microsoft Word with text originating in an Excel workbook from a specified worksheet.
My problem: Selecting said worksheet to draw that information from and integrating result into my code. Using an InputBox for now but would like to replace said InputBox with a UserForm with a ComboBox- giving pre-set choice for worksheet names (these never change).
I've created the UserForm with the choices. How do I get my code to initialize it? And how do I get my code to use the result from the ComboBox?
Sub Ooopsie()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim exSh As Excel.Worksheet
Dim strSheetName As String
Dim strDefaultText As String
strDefaultText = "sheet name here"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText _
)
If strSheetName = strDefaultText Or strSheetName = vbNullString Then Exit Sub
Set exWb = objExcel.Workbooks.Open("path to worksheet")
ActiveDocument.Tables(1).Rows(3).Cells(1).Range.Text = "Blah: " & exWb.Sheets(strSheetName).Cells(3, 3)
ActiveDocument.Tables(1).Rows(5).Cells(1).Range.Text = "blah blah : " & Chr(11) & "blah: " & exWb.Sheets(strSheetName).Cells(3, 1)
ActiveDocument.Tables(1).Rows(6).Cells(1).Range.Text = "Date de réception : " & Chr(11) & "Date Received : " & exWb.Sheets(strSheetName).Cells(3, 2)
ActiveDocument.Tables(1).Rows(7).Cells(1).Range.Text = "blah d : " & Chr(11) & "Deadline: " & exWb.Sheets(strSheetName).Cells(3, 4)
exWb.Close
Set exWb = Nothing
End Sub
I refined your code some. This should get you started. I reworked it to make it easier for you to see what's going on. Instead of opening an existing workbook I create a new workbook. I left the Inputbox in there with some error handling so you get an idea of what you should do. The code now right from the MS Word table to Excel.
Option Explicit
Private Sub CommandButton1_Click()
Dim xlApp, xlWB, xlWS
Dim strSheetName As String, strDefaultText As String
Dim tbl As Table
strDefaultText = "Sheet1"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText)
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
Set xlWS = xlWB.WorkSheets(strSheetName)
If Err.Number <> 0 Then
MsgBox "Worksheet [" & strSheetName & " Not Found", vbCritical, "Action Cancelled"
xlWB.Close False
xlApp.Quit
Exit Sub
End If
On Error GoTo 0
xlApp.Visible = True
On Error Resume Next
If ActiveDocument.Tables.Count > 0 Then
Set tbl = ActiveDocument.Tables(1)
xlWS.Cells(3, 3) = tbl.Rows(3).Cells(1).Range.Text
xlWS.Cells(3, 1) = tbl.Rows(5).Cells(1).Range.Text
xlWS.Cells(3, 2) = tbl.Rows(6).Cells(1).Range.Text
xlWS.Cells(3, 4) = tbl.Rows(7).Cells(1).Range.Text
End If
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
It is worth noting that you can't instantiate Excel from MS Word like this without a reference to the Microsoft Excel 12.0 I think is?
Dim objExcel As New Excel.Application
Use this instead
Dim objExcel as Variant
Set objExcel = CreateObject("Excel.Application")
I know that this is not a chat forum but I am open to opinions and advice. I am only a hobbist after all.
Update here is how one way add items to a combobox
For Each xlSheet In xlWB.Worksheets
ComboBox1.AddItem xlSheet.Name
Next
So you've created a form called UserForm1.
You can display it as a modal dialog using the default instance:
UserForm1.Show vbModal
But a better practice would be to instantiate it instead - forms are objects after all, so you can New them up like any other class module:
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
You can add properties to your form's code-behind to expose values the calling code can use:
Public Property Get SheetName() As String
SheetName = ComboBox1.Text
End Property
So you can now write a function that does this:
Private Function GetSheetName() As String
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
GetSheetName = view.SheetName
End Function
Now you can replace your InputBox call with a call to this GetSheetName function!
Of course you'll want to handle the case where the user cancels out of the form, but that's beyond the scope of this question, and... it's been asked on this site already, just search and you'll find!
This is blowing my mind. I can't find what I'm doing wrong. I hope it's just a case of tunnel vision.
I get error message "Object variable or With block variable not set- 1"
Option Explicit:
Public mWB As Workbook
Public Sub runCSSBatch()
On Error GoTo Errorcatch
1 mWB = ActiveWorkbook
Call createTempSheet
Call findworksheet
Errorcatch:
MsgBox Err.Description & "-" & Erl
Application.DisplayAlerts = False
mWB.Sheets("TEMP").Delete
Application.DisplayAlerts = True
End Sub
Instead of ActiveWorkbook, it may be, ThisWorkbook
set mwb=thisworkbook
I eventually found many things wrong with my script.
I did end up using Set in front of ActiveWorkbook (using ThisWorkbook
was not necessary)
I believe the comment about using 1: instead of 1 to catch the error
was valid.
I am now running the script with quite a few less subs than I was
before.
I also had made the mistake of using Cells() inside Range() when one
excludes the other
I tried to pass a Worksheet Variable to a Sub (apparently you can't
do that).
I'm sure there was more but I can't recall.
I'm going to chalk it up to having a shitty day. :/
As you can see the below code looks nothing like what I had posted initially.
Option Explicit:
Public mWB As Workbook
Public Sub runCSSBatch()
Set mWB = ActiveWorkbook
mWB.Sheets.Add.Name = "TEMP"
Dim WSh As Worksheet
For Each WSh In mWB.Worksheets
If InStr(WSh.Name, "CSS") = 1 Then
Call parseRowText(WSh.Name)
End If
Next
End Sub
Private Sub parseRowText(WSName As String)
Dim rowCount As Long
Dim I As Long
Dim columnCount As Long
Dim B As Long
Dim dataString As String
Dim WS As Worksheet
Set WS = mWB.Worksheets(WSName)
columnCount = mWB.Sheets(WSName).UsedRange.Columns.Count
rowCount = mWB.Sheets(WSName).UsedRange.Rows.Count
For I = 2 To rowCount
For B = 1 To columnCount
dataString = ""
If mWB.Sheets(WSName).Cells(1, B).Value = "STOP" Then
dataString = "}"
Call addToTempSheet(dataString)
Exit For
Else
If B = 1 Then
dataString = mWB.Sheets(WSName).Cells(I, B).Value & "{"
Call addToTempSheet(dataString)
Else
If dataString & mWB.Sheets(WSName).Cells(I, B).Value = "" Then
Else
dataString = mWB.Sheets(WSName).Cells(1, B).Value & ":"
dataString = dataString & mWB.Sheets(WSName).Cells(I, B).Value & ";"
Call addToTempSheet(dataString)
End If
End If
End If
Next B
Next I
End Sub
Private Sub addToTempSheet(dString As String)
mWB.Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = dString
End Sub
I'm completely baffled...this macro looks at a Range, draws a number with Rnd then creates a vlookup to bring back a quote and author every time I open up my workbook (should one apply).
This error just began this evening, but only on today's versions. I am able to open up older versions and run the code just as expected.
Below is "Today's" latest copy and produces the Runtime error, with the break happening on the line defining the string quote:
Private Sub Workbook_Open()
Dim sht As Object
Dim RandNumb As Integer
Dim quote As String
Dim author As String
Dim ws As Worksheet
Set ws = Worksheets("Home")
'Make "Home" Sheet visible and select
ws.Visible = True
'Search for all sheets not named "Home" and hide them
For Each sht In Worksheets
If sht.Name <> "Home" Then
sht.Visible = xlSheetHidden
End If
Next sht
'Create random number, then vlookup based off number
RandNumb = Int((56 - 1 + 1) * Rnd + 1)
quote = Application.WorksheetFunction.VLookup(RandNumb, Sheet3.Range("ba101:bc465"), 2, False)
author = Application.WorksheetFunction.VLookup(RandNumb, Sheet3.Range("ba101:bc465"), 3, False)
If quote <> Empty Then
MsgBox quote & vbNewLine & vbNewLine & " - " & author, vbOKOnly, "Quote of the day"
End If
End Sub
While the version from 2/6 works just fine:
Private Sub Workbook_Open()
Dim sht As Object
Dim RandNumb As Integer
Dim quote As String
Dim author As String
Dim ws As Worksheet
Set ws = Worksheets("Home")
'Make "Home" Sheet visible and select
ws.Visible = True
ws.Select
Range("A1").Select
'Search for all sheets not named "Home" and hide them
For Each sht In Worksheets
If sht.Name <> "Home" Then
sht.Visible = xlSheetHidden
End If
Next sht
'Create random number, then vlookup based off number
RandNumb = Int((56 - 1 + 1) * Rnd + 1)
quote = Application.WorksheetFunction.VLookup(RandNumb, Sheet3.Range("ba101:bc465"), 2, False)
author = Application.WorksheetFunction.VLookup(RandNumb, Sheet3.Range("ba101:bc465"), 3, False)
If quote <> Empty Then
MsgBox quote & vbNewLine & vbNewLine & " - " & author, vbOKOnly, "Quote of the day"
End If
End Sub
These codes look no different to me. Even when I copy the version from 2/6 and put it in "Today's" I continue to receive the error. Help please.
This was solved by #Rory; I had carelessly changed the name of the sheet but not in the code.
Im new to VBA but i need to do something with it. I want to make input box that add a new sheet with specific name. somehow i can make it after some searching over the forum. here are the steps that i want to do, but i cant make it completely done.
make input box that ask a name of new sheet (it's done).
when the name of sheet is already available then a msg box appear
that it can't make a new sheet but when the opposite happen then a
new sheet is made (it's done too).
the last is i want to make when the input box is blank a new msg box
appear and ask to enter different name (this i can't do).
Here's the code im using so far
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If NamaSheet <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
End If
Loop Until Not shExists Or SheetName = ""
End Sub
Private Function SheetExists(ByVal SheetName As String, _
Optional ByVal wb As Workbook)
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = Not wb.Worksheets(SheetName) Is Nothing
End Function
any help will be appreciated, thanks in advance for your attention. ah and sorry for my bad english.
Check if this code helps you:
Just added Else part for you Main If condition where you check If Sheetname is not blank.
Also, You can also uncomment my line Exit Sub if you want to exit subroutine in case of blank input box.
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If SheetName <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
Else
MsgBox "Please enter a sheet name.", vbOKOnly + vbInformation, "Warning"
'Exit Sub
End If
Loop Until Not shExists Or SheetName = ""
End Sub
This code caters for errors for either:
the sheet name already existing
the sheet name being invalid (empty (ie ""), too long or invalid characters)
Code updates so sheet name is validated for length, and then by a Regexp for Valid characters for Excel sheet names before the sheet is created
If either 1 or 2 is true the user is re-prompted (with an additional try again message)
Public Sub CariSheet()
Dim SheetName As String
Dim bFinished As Boolean
Dim strMsg As String
Dim ws As Worksheet
Do While Not bFinished
SheetName = InputBox("Pls enter the name of the sheet", strMsg, "Add Sheet")
On Error Resume Next
Set ws = Sheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Select Case Len(SheetName)
Case 0
strMsg = "Sheet name is blank"
Case Is > 31
strMsg = "Sheet name exceeds 31 characters"
Case Else
If ValidSheetName(SheetName) Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = SheetName
Else
strMsg = "Sheet name has invalid characters"
End If
End Select
Else
strMsg = "Sheet exists"
Set ws = Nothing
End If
Loop
End Sub
test for valid sheet name
Function ValidSheetName(strIn As String) As Boolean
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "[\<\>\*\\\/\?|]"
ValidSheetName = Not objRegex.test(strIn)
End Function
We have an SSRS report that has a separate worksheet for each division. We run a macro to rename all the worksheets with the division name and then copy specific worksheets to a new workbook to be emailed to the divisions. The problem with the code is that if one of the divisions does not have a worksheet that month the macro errors out with an error of "not in specified range". Is there a way to tell it to ignore missing worksheets if they do not exist this time? Here is the code:
Sheets(Array("AB", "CD", "EF", "GH", "IJ", "KL")).Copy
Sheets("AB").Select
ActiveWorkbook.SaveAs Filename:= _
Path & "Holder Agings " & Today & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Thank You!
I agree with Rusan Kax, without a complete block of code it is difficult to produce exactly the code you need. The code below shows two techniques. You should be able to adapt one of them to your requirements.
Option Explicit
Sub Test1()
' Demonstrate CheckWshts(Array) which removes names from the array
' if they do not match the name of a worksheet within the active
' workbook
Dim InxWsht As Long
Dim WshtTgt() As Variant
WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL")
Call CheckWshts(WshtTgt)
For InxWsht = LBound(WshtTgt) To UBound(WshtTgt)
Debug.Print WshtTgt(InxWsht)
Next
End Sub
Sub Test2()
' Demonstrates WorksheetExists(Name) which returns True
' if worksheet Name is present within the active workbook.
Dim InxWsht As Long
Dim WshtTgt() As Variant
WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL")
For InxWsht = LBound(WshtTgt) To UBound(WshtTgt)
If WorksheetExists(CStr(WshtTgt(InxWsht))) Then
Debug.Print WshtTgt(InxWsht) & " exists"
Else
Debug.Print WshtTgt(InxWsht) & " does not exist"
End If
Next
End Sub
Sub CheckWshts(WshtTgt() As Variant)
' * WshtTgt is an array of worksheet names
' * If any name is not present in the active workbook,
' remove it from the array
Dim Found As Boolean
Dim InxWshtActCrnt As Long
Dim InxWshtTgtCrnt As Long
Dim InxWshtTgtMax As Long
InxWshtTgtCrnt = LBound(WshtTgt)
InxWshtTgtMax = UBound(WshtTgt)
Do While InxWshtTgtCrnt <= InxWshtTgtMax
Found = False
For InxWshtActCrnt = 1 To Worksheets.Count
If Worksheets(InxWshtActCrnt).Name = WshtTgt(InxWshtTgtCrnt) Then
Found = True
Exit For
End If
Next
If Found Then
' Worksheet WshtTgt(InxWshtTgtCrnt) exists
InxWshtTgtCrnt = InxWshtTgtCrnt + 1
Else
' Worksheet WshtTgt(InxWshtTgtCrnt) does not exist
WshtTgt(InxWshtTgtCrnt) = WshtTgt(InxWshtTgtMax)
InxWshtTgtMax = InxWshtTgtMax - 1
End If
Loop
' Warning this code does not handle the situation
' of none of the worksheets existing
ReDim Preserve WshtTgt(LBound(WshtTgt) To InxWshtTgtMax)
End Sub
Function WorksheetExists(WshtName As String)
' Returns True is WshtName is the name of a
' worksheet within the active workbook.
Dim InxWshtCrnt As Long
For InxWshtCrnt = 1 To Worksheets.Count
If Worksheets(InxWshtCrnt).Name = WshtName Then
WorksheetExists = True
Exit Function
End If
Next
WorksheetExists = False
End Function