I duplicate a report and rename the tab as per user input.
I need to take that user input and insert it into a formula which would then be placed into a cell. Over time (monthly) the formula would need to change columns.
Below is what I have done so far.
sName is the user defined input, I think I have declared it as a global variable correctly
sName is used in SPVCLookup as the name of the tab (not working)
sName is used in countif as part of a formula (not working)
' will copy SPC Report to new tab and ask user to name the tab
Dim sName As String
Sub CopyRename()
'Dim sName As String
Dim wks As Worksheet
Worksheets("SPC Report").Copy after:=Sheets(Worksheets.Count)
Set wks = ActiveSheet
Do While sName <> wks.Name
sName = Application.InputBox _
(Prompt:="Enter new worksheet name")
On Error Resume Next
wks.Name = sName
On Error GoTo 0
Loop
Set wks = Nothing
End Sub
'------------------------
Sub CreateDA()
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "Departmental Analysis"
End With
End Sub
'------------------------
Sub SPCVlookup()
'Sheets("sName").Select 'this needs to be user defined
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
Sub Countif()
Sheets("Departmental Analysis").Select
' I think I need a for loop to cycle through the range columns
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('sname'!$A$1:$E$12104,A3)"
End Sub
You've got two problems here.
Sub SPCVlookup()
Sheets("sName").Select 'selects the sheet called "sName"
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
This code selects the sheet called "sName". Remove the "" marks:
Sub SPCVlookup()
Sheets("sName").Select 'selects the sheet called "sName"
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=VLOOKUP(D2,'Card Exchange'!$A$1:$V$218,6,FALSE)"
End Sub
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('sname'!$A$1:$E$12104,A3)"
This is a bit trickier. You'll need to copy sName into the formula, but in order to do so you'll need to escape it (just in case sName contains quotes). You can do that by doubling each quote:
Replace(sName, """", """"&"""")
So...
Range(Range("E2"), Range("E2").End(xlDown)).Formula = "=COUNTIFS('" & Replace(sName, """", """"&"""") & "'!$A$1:$E$12104,A3)"
This won't update the cells when sName changes; to do that, you'll need to set a spreadsheet name. Variables in VBA and Formulas aren't shared.
Related
I am trying to select a particular page based on cell value U2. I am using the backend Excel names not the display names for the sheets. "Sheet11" is the sheet I am currently trying to connect to. I have tried the following codes, but getting run-time error 9, out of range.
What could I try next?
Thanks
'#1
Dim ws As Worksheet
ws = Range("U2")
Set ws = ActiveSheet
'#2
(Range("U2").Activate
'#3
Sheet11.Activate
Works but no variable
'#4
Sheets(Range("U2").Text).Activate
'#5
Sheets(Range("U2").Value).Activate
'#6
Dim GetString As String
GetString = Range("U2")
GetString.Activate
Is this what you are looking for?
Sheets(ActiveSheet.Range("U2").Value).Select
Reference a Worksheet By Its Code Name
Option Explicit
Sub RefByCodeName()
' Write the code name to a string variable ('wscName').
' Adjust the worksheet!
Dim wscName As String: wscName = CStr(Sheet1.Range("U2").Value)
' Using the 'RefWorksheetByCodeName' function, attempt to reference
' the worksheet ('ws') by its code name.
Dim ws As Worksheet: Set ws = RefWorksheetByCodeName(wscName, ThisWorkbook)
' Validate the worksheet.
If ws Is Nothing Then
MsgBox "No worksheet with the code name '" & wscName & "' found.", _
vbCritical
Exit Sub
End If
' Continue, e.g.:
'MsgBox "Name: " & ws.Name & vbLf & "Code Name: " & ws.CodeName, _
vbInformation
' Make sure the workbook is active.
If Not ThisWorkbook Is ActiveWorkbook Then ThisWorkbook.Activate
' Select the worksheet.
ws.Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a workbook ('wb'), references a worksheet
' by its code name ('WorksheetCodeName').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefWorksheetByCodeName( _
ByVal WorksheetCodeName As String, _
ByVal wb As Workbook) _
As Worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets
If StrComp(ws.CodeName, WorksheetCodeName, vbTextCompare) = 0 Then
Set RefWorksheetByCodeName = ws
Exit Function
End If
Next ws
End Function
Sheets have 3 ways of referring to them:
Name (What you see on the tab at the bottom)
Index (A number representing the sheet's position in the workbook, i.e. this will change if you change the position of a sheet)
CodeName (This is what you refer to as the back end excel name)
You can select a sheet using any of these. If I had a workbook with tabs named after months in Jan to Dec order and I haven't changed the code names the code to select November using each would be as follows:
1.Name Worksheets("November").Select
2.Index Worksheets(11).Select
3.CodeName Sheet11.Select
Unlike name and index you can refer to the codename directly as it is an object.
the following code uses the index to loop through the sheet codenames comparing them to the value in U2 when it is the same as U2 it will select the sheet.
Dim lCodeName As String
Dim lWSCount, lCount As Integer
lCodeName = ActiveSheet.Range("U2").Value
lWSCount = ActiveWorkbook.Worksheets.Count
For lCount = 1 To lWSCount
If Worksheets(lCount).CodeName = lCodeName Then
Worksheets(lCount).Select
Else
End If
Next
I am writing a VBA code where I need to find if sheet name given by user through inputbox is available or not in a workbook containing many sheets.
But if the sheet name is not available then the inputbox pops up again to enter the sheet name so it can search again.
I have written 1st part of the code which is working fine but I need help with the 2nd part(if the sheet name is not available). Let me know if this is possible in for loop or I have to use other loop?
Sub callbyinputbox()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If sht.Name = entername Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
MsgBox ("You entered " & entername & vbNewLine & "Sheet by this name is not available")
end sub
Here is your code:
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If sht.Name = enterDate Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
You store the response from the user in a variable: entername.
You then loop through all the sheets and check if the name matches a variable called enterDate.
Change this to entername and it will then have something to match against, and the If block will run.
Check out using Option Explicit - this would have highlighted this issue for you.
UPDATE:
This is probably breaking an unwritten rule somewhere, but a simple Do Until False loop, which will permanently run (until the Exit Sub condition is reached and breaks the loop) will keep asking until a valid sheetname is input.
Alternatively, you could use a For.. Next loop. That way, you could set a maximum number of prompts before giving up..
Note: I have made this comparison case insensitive - to give the user a better chance of inputting a correct sheet name.
Sub callbyinputbox()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
Do Until False
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If LCase(sht.Name) = LCase(entername) Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
MsgBox ("You entered " & entername & vbNewLine & "Sheet by this name is not available")
Loop
End Sub
All the while, I have attempted to correct your code and explain the reasoning. For that reason, I have tried to keep as much of your code as possible and just steer you toward your goal. If I was writing this from scratch, I would use the approach suggested by Ike.
To handle all usecases (no input given, existing sheetname given, non-existing sheetname given) - you can use this code:
Public Sub activateSheetByUserInput()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
retry:
entername = InputBox("Enter name", "Search Sheet")
If LenB(entername) = 0 Then
Exit Sub
ElseIf tryGetWorksheetByName(pendworkbook, entername, sht) = True Then
sht.Activate
Else
'give the user the option to cancel the process
If vbCancel = MsgBox("You entered " & entername & vbNewLine & "Sheet by this name is not available", vbCritical + vbRetryCancel) Then
Exit Sub
Else
GoTo retry
End If
End If
End Sub
'function returns true if worksheet was found - plus the ws itself
Private Function tryGetWorksheetByName(ByVal wb As Workbook, ByVal strName, ByRef sht As Worksheet) As Boolean
On Error Resume Next 'one of the rare cases where it is valid to use on error resume next
Set sht = wb.Worksheets(strName)
If Err = 0 Then tryGetWorksheetByName = True
On Error GoTo 0
End Function
Another way would be to supply a list of valid sheet names and ask them to select one.
Add a userform and place a listbox on it. I've left the default names, but would be better to name the controls to something relevant.
Add this code to the form:
Private Sub UserForm_Initialize()
Dim pendworkbook As Workbook
Set pendworkbook = Workbooks("pend_app_new.xlsx")
Dim shts() As Variant
ReDim shts(0 To 0, 0 To pendworkbook.Worksheets.Count - 1)
Dim x As Long
For x = 1 To pendworkbook.Worksheets.Count
shts(0, x - 1) = pendworkbook.Worksheets(x).Name
Next x
ListBox1.List = Application.WorksheetFunction.Transpose(shts)
End Sub
Private Sub ListBox1_Click()
MsgBox "You clicked " & ListBox1.Value
End Sub
I want a user to be able to select a cell with a sheet name in it, and then have a single macro button go to that worksheet. How do I get VBA to use the contents of the selected cell?
I have one setup to go back to the "Summary" worksheet, but want to let users go quickly to a selected sheet without having to create a different macro for each sheet as the user will be adding sheets to the workbook over time.
Sub Return_to_Summary()
' Return_to_Summary Macro
Sheets("Summary").Select
End Sub
You might also want to add in some validation or error checking.
Public Sub Return_to_Summary()
Dim sName As String
Dim oSht As Worksheet
Dim bFound As Boolean
bFound = False
sName = ActiveCell.Text
For Each oSht In ActiveWorkbook.Sheets
If oSht.name = sName Then
bFound = True
Exit For
End If
Next
If bFound = True Then
Sheets(ActiveCell.Text).Activate
Else
MsgBox "This worksheet (" & sName & ") cannot be found. Check the spelling and capitalization."
End If
End Sub
Continuing the question:
TextBox object customisation - Compile error: Invalid or unqualified reference
I am going to copy this element - textbox into all worksheets throughout my document.
I would like to have it exactly in the same place in each worksheet.
For this purpose I used the code:
Sub Asbuildcopy()
Dim wsh As Worksheet
Dim ArraySheets As String
Dim x As Variant
For Each wsh In ActiveWorkbook.Worksheets
ActiveSheet.Shapes("Textbox 3").Copy
Application.Goto Sheets(ArraySheets).Range("Q6")
ActiveSheet.Paste
ArraySheets(x) = wsh.Name
x = x + 1
End Sub
According to the advice here:
https://www.ozgrid.com/forum/index.php?thread/73851-copy-shape-to-cell-on-another-worksheet/
https://i.stack.imgur.com/lOhJj.png
stating about copying an element into another sheet.
Apart from my code, one problem is the location of this element. I used target cell as Q6, but I would like to have it exactly in the same place as on the 1st (initial) sheet.
Thank you for your hint,
Try this. As per comment, can use the Top and Left properties of a shape to position it as per the first sheet.
Use more meaningful procedure and variable names for your actual code.
Sub x()
Dim ws As Worksheet, ws1 As Worksheet, s As Shape
Set ws1 = Worksheets("Sheet1") 'sheet containing original textbox
Set s = ws1.Shapes("TextBox 3") 'name of original textbox
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> ws1.Name Then
s.Copy
ws.Paste
ws.Shapes(ws.Shapes.Count).Top = s.Top
ws.Shapes(ws.Shapes.Count).Left = s.Left
End If
Next ws
Application.ScreenUpdating = True
End Sub
I'm using a macro to make a copy of the active sheet, and rename it to whatever the value of cell 'C2' is. The only problem is, that when it copies the sheet, it somehow removes the form buttons from the top of my worksheet and replaces them with the code =$c$2 in cell 'AF'.
As far as i can see from the VBA code there is nothing that refers to the cell 'AF'. Can anyone tell me why it's doing this ?
Sub Copy_Rename()
Dim shtName As String
shtName = ActiveSheet.Name
ActiveSheet.Copy before:=ActiveSheet
ActiveSheet.Name = Range("C2").Value
Sheets(shtName).Activate
End Sub
Try this:
Sub Copy_Rename()
Dim sht As Worksheet
Set sht = ActiveSheet
Application.CopyObjectsWithCells = True '<< to also copy objects not just cell contents etc
sht.Copy before:=sht
'Get the just-created sheet
With Sheets(sht.Index - 1)
.Name = sht.Range("C2").Value
.Activate
End With
End Sub