I found a lot of examples but it's not working in my case and I don't know why.
Very basic code:
Sub Test()
Dim namCur As Name
For Each namCur In ActiveSheet.Names
MsgBox "Name: " & namCur.Name & ", Refers To: " & namCur.RefersTo
Next namCur
End Sub
And I have the same issue when I use Worksheets("Assumptions").Names
When I watch ActiveSheet.Name, this is correct I get "Assumptions", you can see on the picture below the list of named ranges. But I never get the MsgBox and the For loop goes directly to the end.
Edit: Very important, I need to loop only this sheet's named ranges, not the whole workbook
Any idea?
I use Excel 2016
Your solution will only list Names that have a scope set to only the ActiveSheet.
Change this
For Each namCur In ActiveSheet.Names
To this
For Each namCur In ThisWorkBook.Names
to list all names in the Workbook. You can then check the RefersTo address to check if it applies to the ActiveSheet.
Sub Test()
Dim namCur As Name
Dim TargetSheetName As String
TargetSheetName = "Assumptions"
For Each namCur In ThisWorkbook.Names
If Range(namCur.RefersTo).Parent.Name = TargetSheetName Then MsgBox "Name: " & namCur.Name & ", Refers To: " & namCur.RefersTo
Next namCur
End Sub
Related
So I am trying to create a workbook that uses multiple references from a worksheet of the initial data to auto fill cells in different worksheets to produce Forms (pre-formated worksheets). For one of the worksheets, I need to save it on a separate network drive as its own .xlsx workbook. So far, the code I have developed creates the new workbook, but the cells all still contain the original formulas that reference the original workbook. Is there a way, when saving into the new workbook, to convert the cells to values? Here is the sub I have in place. TIA
Private Sub SaveBidTab1_Click()
' Saves the BidTab in the Current Year's Bid Tabs Folder in
' Dave's Snapserver Construction Files
Dim BTFName As String 'this will be the name of the new file name saved in the Bid Tabs Folder
Dim BTFfolder As String 'This is the folder to save the form into
Dim BTFDate As String 'This is the date to choose which year's folder to use
Dim ProjectShortName As String 'This is the short name for the project for the file name
Dim NewBook As Workbook ' This is temp workbook that the new bid tab sheet will be saved as
If Worksheets("BidTab").Range("G12") = "" Then
ans = MsgBox("This form is not ready to be saved", vbOKOnly, "Bid Tabs")
Select Case ans
Case vbOK
Exit Sub
End Select
End If
'Requests user to enter in short name for project
Msg = "Enter Project Short Name"
ProjectShortName = InputBox(Msg, "Save As")
' TRIAL is added here until project is compelted.
BTFName = "TRIAL " & Worksheets("Initial Entry").Range("B5") & " " & ProjectShortName & _
" " & "Bid Tab Results" & " " & Worksheets("BidTab").Range("L5")
' Add in a cancle option to this msgbox
MsgBox BTFName
BTFDate = Year(Now())
BTFfolder = "M:\DotserverD\Daves Snapserver Files Construction Files\Bid Tabs\" & BTFDate _
& "\County"
Debug.Print BTFfolder
Set NewBook = Workbooks.Add
ThisWorkbook.Worksheets("BidTab").Copy Before:=NewBook.Sheets(1)
NewBook.SaveAs Filename:=BTFfolder & "\" & BTFName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub
ThisWorkbook.Worksheets("BidTab").Copy Before:=NewBook.Sheets(1)
Put this after the above statement:
With NewBook.Sheets(1).UsedRange
.Value = .Value
End With
This will remove the links and keep only the values in the new worksheet.
I have this in a similar book. You can probably simplify it.
Dim shShape As Shape
For i = 1 To UBound(sheetNames)
mSaveWorkbook.Sheets(i).Name = sheetNames(i)
If mSaveWorkbook.Sheets(i).Shapes.Count > 0 Then
For Each shShape In mSaveWorkbook.Sheets(i).Shapes
If shShape.Type = msoFormControl Then
shShape.Delete
End If
Next shShape
End If
Next i
End If
I am quite new in VBA and wrote a subroutine that copy-paste cells from one document into another one. Being more precise, I am working in document 1 where I have names of several product (all in column "A"). For these product, I need to look up certain variables (e.g. sales) in a second document.
The subroutine is doing the job quite nicely, but I want to use it as a funcion, i.e. I want to call the sub by typing in a cell "=functionname(productname)".
I am grateful for any helpful comments!
Best, Andreas
Sub copy_paste_data()
Dim strVerweis As String
Dim Spalte
Dim Zeile
Dim findezelle1 As Range
Dim findezelle2 As Range
Dim Variable
Dim Produkt
'Variable I need to copy from dokument 2
Variable = "frequency"
'Produkt I need to copy data from document 2
Produkt = Cells(ActiveCell.Row, 1)
'path, file and shhet of document 2
Const strPfad = "C:\Users\Desktop\test\"
Const strDatei = "Bezugsdok.xlsx"
Const strBlatt = "post_test"
'open ducument 2
Workbooks.Open strPfad & strDatei
Worksheets(strBlatt).Select
Set findezelle = ActiveSheet.Cells.Find(Variable)
Spalte = Split(findezelle.Address, "$")(1)
Set findezelle2 = ActiveSheet.Cells.Find(Produkt)
Zeile = Split(findezelle2.Address, "$")(2)
'copy cell that I need
strZelle = Spalte & Zeile 'Zelladresse
strVerweis = "'" & strPfad & "[" & strDatei & "]" & strBlatt & "'!" & strZelle
'close document 2
Workbooks(strDatei).Close savechanges:=False
With ActiveCell
.Formula = "=IF(" & strVerweis & "="""",""""," & strVerweis & ")"
.Value = .Value
End With
End Sub
Here is an example to create a function that brings just the first 3 letters of a cell:
Public Function FirstThree(Cell As Range) As String
FirstThree = Left(Cell.Text, 3)
End Function
And using this in a Excel worksheet would be like:
=FirstThree(b1)
If the sub works fine and you just want to make it easier to call you can add a hotkey to execute the Macro. In the developer tab click on Macros then Options. You can then add a shortcut key (Crtl + "the key you want" it can be a shortcut key already used like C, V, S, but you will lose those functions (Copy, Paste Save, Print)
enter image description here
I have an extensive Workbook which exists in multiple versions that contains hundreds of named ranges.
I want to write a macro that transfers user input data entered to certain named ranges from one instance of the book to another.
The named ranges in the book follow a certain convention, for the purposes of this macro i want to copy the values (which are constants) of all named ranges starting with "in_*" and "resetRange_*"
the macro is supposed to:
open the source book (which has mostly the same named ranges defined as the current book)
iterate over all named ranges of the source book and find the ones like "in_*" or "resetRange_*"
copy the values at the named ranges from the source book to the current book (even if the names refer to areas)
my main questions are:
how do i copy correctly? the current implementation does not work
is there a better way to test whether a source name is still present in the current book?
the named ranges in question all are scoped to the workbook.
The issue that the macro runs error free but does not paste any values. the named ranges of the current book remain empty while the source book contains data
ยด
Public Sub TransferInputDataFromOtherTool()
Dim sourceBook As Workbook
Dim bookPath As Variant
'get source book
bookPath = Application.GetOpenFilename("(*.xlsm), *.xlsm", Title:="Select source tool:")
If VarType(bookPath) = vbString Then
Set sourceBook = Workbooks.Open(bookPath)
End If
On Error GoTo Cleanup
'#TODO transfer ranges _
resetRange_* _
in_*
'retrieving data
For Each n In sourceBook.Names
On Error Resume Next
rangeName = n.Name
boola = ThisWorkbook.Names(n.Name)
If boola Then
On Error GoTo 0
If rangeName Like "in_*" _
or rangeName like "resetRange_*" Then
'check for allow edit
On Error Resume Next
sourceBook.Activate
source_value = n.refersToRange.Value
ThisWorkbook.Activate
Range(rangeName).Value = source_value
'Debug.Print rangeName, source_value
'Debug.Print Err.Description, Err.source
On Error GoTo 0
End If
' deleting all in_-values
End If
Next n
'#TODO transfer tables
'ExcelHandling.EnableInteractivity
Cleanup:
On Error Resume Next
sourceBook.Close
On Error GoTo 0
End Sub
Here's a code sample to help. Please turn on Option Explicit and define all your VBA variables. See if this works for you:
EDIT: added range check to detect more than one cell in a given range, then to copy each cell
Option Explicit
Sub TransferInputDataFromOtherTool()
Dim srcWB As Workbook
Dim destWB As Workbook
Dim filename As String
Dim definedVariable As Name
Dim singleCell As Range
Dim singleCellLocation As String
'--- the destination book is the currently active workbook from the user's perspective
Set destWB = ThisWorkbook
'--- source book from which to copy the data from - user selected
filename = Application.GetOpenFilename("(*.xlsm), *.xlsm", Title:="Select source tool:")
If filename = "False" Then
'--- the user selected cancel
Exit Sub
ElseIf filename = destWB.Path & "\" & destWB.Name Then
MsgBox "You can't open the same file that's already active. Select another file.", vbCritical + vbOKOnly
Exit Sub
Else
Set srcWB = Workbooks.Open(filename)
End If
Debug.Print "values coming from " & filename
For Each definedVariable In srcWB.Names
If (definedVariable.Name Like "in_*") Or (definedVariable.Name Like "resetRange_*") Then
'--- if the source/destination range is only a single cell, then
' it's an easy one-to-one copy
Debug.Print definedVariable.Name & " refers to " & definedVariable.RefersTo;
If destWB.Names(definedVariable.Name).RefersToRange.Cells.Count = 0 Then
'--- do nothing
ElseIf destWB.Names(definedVariable.Name).RefersToRange.Cells.Count = 1 Then
Debug.Print " source value = '" & destWB.Names(definedVariable.Name).RefersToRange.Value & "'";
Debug.Print " overwritten with '" & srcWB.Names(definedVariable.Name).RefersToRange.Value & "'"
destWB.Names(definedVariable.Name).RefersToRange = srcWB.Names(definedVariable.Name).RefersToRange.Value
Else
'--- the source/target range has multiple cells, either contiguous
' or non-contiguous. so loop and copy...
Debug.Print vbTab & "multiple cells in range..."
For Each singleCell In destWB.Names(definedVariable.Name).RefersToRange
singleCellLocation = "'" & singleCell.Parent.Name & "'!" & singleCell.Address
Debug.Print vbTab & " source value = '" & singleCell.Value & "'";
Debug.Print "' overwritten with '" & srcWB.Sheets(singleCell.Parent.Name).Range(singleCell.Address).Value & "'"
singleCell.Value = srcWB.Sheets(singleCell.Parent.Name).Range(singleCell.Address).Value
Next singleCell
End If
End If
Next definedVariable
srcWB.Close SaveChanges:=False
Set srcWB = Nothing
Set destWB = Nothing
End Sub
I'm at a loss when trying to figure out where this code is tripping up. I am looking to rename the activesheet by using a concat of two ranges on the activesheet and some static text. When only one worksheet is in the workbook, the code works great. As soon as a second worksheet is added, I get a Runtime Error 1004. I'll highlight the line of code where it is breaking. This code currently resides in a normal module.
Option Explicit
Sub updateName()
Dim fNumber
Dim pCheckNumber
Dim asName As String
Dim tempASName As String
Dim worksheetName As Object
If ActiveSheet.Name = "Launch Page" Then Exit Sub
fNumber = ActiveSheet.Range("FlightNumber").Value
pCheckNumber = ActiveSheet.Range("PerformanceCheckNumber").Value
If fNumber <> "" And pCheckNumber <> "" Then
tempASName = "Flight " & fNumber & " | Run " & pCheckNumber & " (0.0%)"
asName = tempASName
MsgBox ActiveSheet.Name & vbCr & asName
ActiveSheet.Name = asName
worksheetName.Caption = asName
Else
Exit Sub
End If
End Sub
I'm in the process of adding error checking to ensure that I don't have duplicate sheet names. However, due to the nature of the field names, this will never occur.
I appreciate all of the insights!
The error you are reporting is, most likely, provoked because of trying to rename a Worksheet by using a name already in use. Here you have a small code to avoid this kind of situations:
Dim newName As String: newName = "sheet1"
Dim addition As String: addition = "_2"
Do While (Not sheetNameFree(newName))
newName = newName & addition
Loop
Where sheetNameFree is defined by:
Function sheetNameFree(curName As String) As Boolean
sheetNameFree = True
For Each Sheet In ActiveWorkbook.Sheets
If (LCase(Sheet.Name) = LCase(curName)) Then
sheetNameFree = False
Exit Function
End If
Next Sheet
End Function
You can adapt this code to your specific needs (for example, by converting addition into a number which grows after each wrong name).
In your code I see one other problem (although it shouldn't be triggering a 1004 error): you are accessing the property Caption from an non-instantiated object (worksheetName), whose exact functionality is not too clear. Just delete this line.
NOTE: good point from KazJaw, you might be using an illegal character. If fNumber and pCheckNumber are numbers or letters, it would be OK.
NOTE2: if with worksheetName you want to refer to an ActiveX Label in your workSheet, better do: ActiveSheet.Label1.Caption (where Label1 is the name of the Label). You cannot define worksheetName as a Label, because it is not a "conventional Label".
I am trying to create a macro that brings in the name of the sheet and combine it with text. For example, for sheet one, I want it to say "ThisIs_Sheet1_Test" in I5 of Sheet1. There are several sheets but it should work for all of them.
What is wrong with my code? I think the underscore might be ruining it all. Here's what I have:
Dim SheetName As String
Public Sub CommandButton1_Click()
SheetName = ActiveSheet.Name
Sheets("Sheet1").Range("I5", "I5") = ThisIs_" & SheetName.text & "_Test
Sheets("Sheet2").Range("H5", "H5") = ThisIs_" & SheetName.text & "_Test
Sheets("Sheet3").Range("G5", "G5") = ThisIs_" & SheetName.text & "_Test
End Sub
This question has been forwarded to Pull in Earlier Value Using Concatenation
looks like a quoting problem. ThisIs_ and _Test are strings, right? So the quotes should be around them, not around & SheetName.text &
Sheets("Sheet1").Range("I5", "I5") = "ThisIs_" & SheetName.text & "_Test"
In addition to the missing quotes, SheetName is a string, not an object, so it won't have a Text property. Did you want the name of the sheet to change as the sheet changes? You need this:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
For Each ws In Me.Parent.Worksheets
ws.Range("I5").Value = "ThisIs_" & ws.Name & "_Test"
Next ws
End Sub
I am able to get it to work...sort of.
Now, it displays ThisIS_Sheet1_Test in Sheet1, etc.
However, I have it set up to pull data from a listbox into a function which I called ThisIS_Sheet1_Test. I figured that once I got it to display the name, it would pull the function in. Here's what I have above:
Public Sub ListBox2_LostFocus()
ListBox2.Height = 15
With ListBox2
ThisIS_Sheet1_Test = "'"
For i = 0 To .ListCount - 1
If .Selected(i) Then
ThisIS_Sheet1_Test = ThisIS_Sheet1_Test & .List(i) & "','"
End If
Next i
End With
ThisIS_Sheet1_Test = Left(ThisIS_Sheet1_Test, Len(ThisIS_Sheet1_Test) - 2)
End Sub
How come when I get the text I want it doesn't translate into the function I thought it would.
can you take few minutes to compile your code (in VBA Window, Debug->Compile VBA Project) before looking for other's help?? That would have screamed about your missing quotes, using .Text on a string variable etc.
Public Sub dummy()
Dim SheetName As String
SheetName = ActiveSheet.Name
Sheets("Sheet1").Range("I5", "I5") = "ThisIs_" & SheetName & "_Test"
Sheets("Sheet2").Range("H5", "H5") = "ThisIs_" & SheetName & "_Test"
Sheets("Sheet3").Range("G5", "G5") = "ThisIs_" & SheetName & "_Test"
End Sub
Underscore carries a special meaning in VBA/VB world. Its code concatination (meaning if your code is too long and you want to split it across two lines then you put a space underscore ( _) and continue with next line. And also Dick Kusleika is right about object/string. Only for objects you will have differnt peopreties (.Text means you are asking for Text property of that object), and usually that Text property would be of String type. here you already have a String, and you just use it as it is.