I tried to create a macro that is on worksheet overview. This worksheet should be copied and renamed into Test 1. If I go back to the overview worksheet and start the macro again the newname of the ws should be Test 2 and so on.
I already tried Solutions with Count and if then but it is not working. Currently it runs once and then it says the ws already exists:
Sub CopyWs()
Dim NewName As String
ActiveSheet.Copy Before:=ActiveSheet
NewName = "Test " & WsNo + 1
WsNo = WsNo + 1
ActiveSheet.Name = NewName
End Sub
I'm not sure if this is what you're looking for, but I had a similar issue in the past, and I used the following methodology to solve it.
Dim worksheetName As String
worksheetName = "Test 1"
worksheetNumber = 2
CheckName:
For Each ws in Sheets
' If the desired worksheet name exists
If ws.name = worksheetName Then
' Change the worksheetName to be Test x+1 and increment worksheetNumber
worksheetName = "Test " & worksheetNumber
worksheetNumber = worksheetNumber + 1
GoTo CheckName ' return to the CheckName label and start again
End If
Next ws
Essentially, what we are doing is looping through every worksheet in the current workbook, and checking if any of them have the same name as the one we want to insert. If they do, we change the name to a new one and check again; if not, we have our new name.
EDIT: Also, I would suggest putting the above code inside a Function that takes the sheet name as an argument, so you can change the desired name easily, like so:
Function worksheetName(desiredName As String) As String
Dim worksheetName As String
worksheetName = desiredName
' rest of code follows ...
End Function
And then it can be called like so:
NewName = worksheetName("Test")
Related
The following code works:
Dim shts As Sheets
Set shts = Sheets(Array("Sheet1", "Sheet2"))
What I would like to do is add sheets that may be created in the future to the shts collection. The way I thought this would be accomplished involves using a loop where the sheet names are joined in a large string, making sure to obey the same formatting as in the example above. This is my non-working code:
Dim shts As Sheets
Dim wks() As Worksheet
Dim str As String
ReDim wks(0 To Sheets.Count)
Set wks(0) = Sheets(1)
str = wks(0).Name & """"
For i = 1 To UBound(wks)
Set wks(i) = Sheets(i)
str = str & ", """ & wks(i).Name & ""
Next i
Set shtsToProtect = Sheets(Array(str)) ' ERROR
[Run-time error '9': Subscript out of range]
I've tried several variants of the string argument, still no luck.
You can collect the subset sheets name into a string separated by given delimiter and then use Split() function to get an array out of it
Sub Test()
With ThisWorkbook
Dim shSubSetNames As String
Dim sh As Worksheet
For Each sh In .Worksheets
If sh.Name Like "Sheet*" Then ' change criteria as per your needs
shSubSetNames = shSubSetNames & sh.Name & "|"
End If
Next
If shSubSetNames <> vbNullString Then
shSubSetNames = Left$(shSubSetNames, Len(shSubSetNames) - 1)
Dim subSetShts As Sheets
Set shts = Sheets(Split(shSubSetNames, "|"))
shts.Select
End If
End With
End Sub
This is a solution to directly get to your goal, based on the code you wrote so far. You probably need to realize that having an array of worksheet names is not the same as only a string of names separated by commas. The latter is still just a string, not an array.
Sub Foo()
Dim i As Long
Dim shts() As String
ReDim shts(1 To ThisWorkbook.Worksheets.Count)
For i = 1 To ThisWorkbook.Worksheets.Count
shts(i) = ThisWorkbook.Worksheets(i).Name
Next i
Worksheets(shts).Select
End Sub
But as noted in the comments, there is something much simpler you can do:
Sub Bar()
ActiveWorkbook.Worksheets.Select
End Sub
I am trying to create a subroutine that will take a collection of a bunch of strings, step through it, and check for the existence of a named range or formula that has that string as it's name. Trying it with just one item first:
Dim colCritNames As New Collection
colCritNames.Add "Version" 'the name of a named formula
For i = 1 To colCritNames.Count
nm = CStr(colCritNames(i).Name)
nmchk = Check_UW_For_Name(nm)
If Not nmchk Then Call Fail("Critical Name") 'prints a msgbox with the error type so I know what happened
Next i
'...code for if all the names are there...
Function Check_UW_For_Name(find_name As String) As Boolean
Dim wb As Workbook
Set wb = UserFileBook 'global ref to the workbook to check
On Error Goto Fail
Check_UW_For_Name = CBool(Len(wb.Names(find_name).Name) <> 0)
On Error GoTo 0
End Function
Thats edited from the full thing. Check_UW_For_Name was working fine when I just called it with "Version" as the argument Check_UW_For_Name("Version"); it found it in USerFIleBook, and when I called it with "Nope", since there is no Nope name it went to my error handler. But when I try to use a collection to store the names I want to look for I keep getting 'ByRef argument mismatch'. I tried just nm = colCritNames(i) and nm=colCritNames(i).Name, I tried having find_name be Variant and adding a ByVal, and I originally tried having nm be a Name, having Check_UW_For_Name(find_name as Name) and using a for each (for each nm in colCritNames...) and none of it has worked.
How could I set a collection of names and step through it to see if there's a named range/formula that matches in the relevant workbook? Or is there a better way to do this? (I need the collection in other places too)
I don't quite understand what your plan is with a collection, but this will add any cell with the specified string in, as well as any ranges. What you're doing once they've been identified (added to collection) is not clear to me, but hopefully this makes sense and gets you going.
Sub RunForEachString()
Const yourStrings = "foo,bar,hope,this,works"
Dim stringsAsArray() As String
stringsAsArray = Split(yourStrings, ",")
Dim i As Long
For i = LBound(stringsAsArray) To UBound(stringsAsArray)
Call findAllNamesFormulas(stringsAsArray(i), ThisWorkbook)
Next i
End Sub
Private Sub findAllNamesFormulas(theText As String, theWorkbook As Workbook)
Dim ws As Worksheet, n As Name, aCell As Range
Dim aCollection As New Collection
For Each ws In ThisWorkbook.Worksheets
For Each aCell In ws.UsedRange.Cells
If InStr(1, aCell.Formula, theText, vbTextCompare) > 0 Then
aCollection.Add (aCell)
End If
Next aCell
Next ws
For Each n In ThisWorkbook.Names
If InStr(1, n.Name, theText, vbTextCompare) > 0 Then
aCollection.Add (n)
End If
Next n
'not sure what you plan to do after collection?
Debug.Print aCollection.Count
End Sub
This works for me:
Sub Tester()
Dim colCritNames As New Collection, nm, wb As Workbook, msg As String
colCritNames.Add "Version"
colCritNames.Add "NotThere"
colCritNames.Add "AlsoNotThere"
Set wb = ThisWorkbook 'for example
For Each nm In colCritNames
If Not Check_UW_For_Name(wb, CStr(nm)) Then
msg = msg & vbLf & " - " & nm
End If
Next nm
If Len(msg) > 0 Then
MsgBox "One or more required names are missing:" & msg, _
vbExclamation, "Oops"
Exit Sub
End If
'proceed if OK...
End Sub
'check for a defined Name `find_name` in workbook `wb`
' prefer wb as parameter over using a Global....
Function Check_UW_For_Name(wb As Workbook, find_name As String) As Boolean
On Error Resume Next
Check_UW_For_Name = (wb.Names(find_name).Name = find_name)
End Function
You could create a collection of all named ranges in the workbook like this:
Private Sub NamedRangesDemo()
Dim NamedRanges As New Collection, NamedRange As Variant
For Each NamedRange In ThisWorkbook.Names
NamedRanges.Add NamedRange.Name
Next NamedRange
End Sub
And then compare the whatever strings you want to the NamedRanges collection.
By the way, this question is somewhat similar to yours.
How can I concatenate the word "Sheet" with a number (say, 2) to form a string that can be used as the code name of a sheet.
I've tried the following piece of code but it doesn't seem to work.
Sh = "Sheet" & 2
Range("A1") = Sh.index
If you want to refer the sheet just based on index you could try something like this as well ... hope it works for you
Sub trial()
i = 2
Sheets(i).Select
End Sub
I assume you want to check if a given â–ºstring argument (CodeNameString) refers to a valid Code(Name) in the VBA project. *)
If so, the following function returns the worksheet to be set to memory; otherwise the second argument IsAvailable passed by reference will change to False and can be used for error checks (c.f. ExampleCall below).
Function SheetByCodename(ByVal CodeNameString As String, ByRef IsAvailable As Boolean) As Object
'check for same CodeName in Sheets collection
Dim ws As Object
For Each ws In ThisWorkbook.Sheets
If ws.CodeName = CodeNameString Then ' check for string identity
Set SheetByCodename = ws ' set sheet object to memory
IsAvailable = True ' assign true to 2nd argument passed ByRef
Exit For
End If
Next
End Function
Example call
Sub ExampleCall()
dim cnt As Long: cnt = 2 ' << change example counter
Dim okay As Boolean ' << needed variable passed as 2nd function argument
With SheetByCodename("Sheet" & cnt, okay)
If okay Then
Debug.Print _
"a) Worksheet Name: " & .Name & vbNewLine & _
"b) Sheet's Code(Name) in Project: " & .CodeName
Else
Debug.Print "Given string refers to no valid Code(Name)."
'do other stuff to handle the wrong input
End If
End With
End Sub
*) Take note of #RonRosenfeld 's important remarks in comment:
"Codename is assigned when the worksheet is created. It can be changed in the properties window. In order to change it programmatically, you need to enable Trust Access to the VBA object model. Otherwise, it's a read-only property. "
I have a list of files with the same structure and I want to extract some information from columns A, B, and C and print it to another workbook.
I found a way to do it for a single file, but now I don't understand how can I do it using the list of given files. I tried using collections, but it doesn't work.
Here's what I came up with:
Sub Pulsante1_Click()
Dim FileGeStar As Variant
Dim myCol As Collection
Set myCol = New Collection
myCol.Add "C:\Users\xxx\Desktop\articoli_def.xlsx"
myCol.Add "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx"
For Each FileGeStar In myCol
Workbooks.Open Filename:=FileGeStar
FileGeStar = Application.ActiveWorkbook.Name
Dim Code As String
Dim Description As String
Dim FilePath As String
Dim i As Long
i = 2
While Range("A" & i) <> ""
FilePath = Application.ActiveWorkbook.Path
Code = Trim(Range("A" & i).Value)
Description = Trim(Range("B" & i).Value)
Workbooks("Report.xlsm").Worksheets(1).Range("A" & i).Value = FilePath
Workbooks("Report.xlsm").Worksheets(1).Range("B" & i).Value = Code
Workbooks("Report.xlsm").Worksheets(1).Range("C" & i).Value = Description
i = i + 1
Wend
Next FileGeStar
End Sub
What can I do?
This might look like an overkill, but I hope the code and comment's are self explanatory:
Option Explicit
Sub Pulsante1_Click()
Dim DestinationWorkbook As Workbook
Set DestinationWorkbook = ThisWorkbook 'I think report.xlsm is the workbook running the code
'if report.xlsm is not the workbook running the code then change thisworkbook for workbooks("Report.xlsm")
'add as many paths as you need to, another way would be to write them in a sheet and loop through to fill the array
Dim MyPaths As Variant
MyPaths = Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'Declare a workbook variable for the source workbooks
Dim SourceWorkbook As Workbook
'Declare a long variable to loop through your path's array
Dim i As Long
'loop through the start to the end of your array (will increase as the array does)
For i = LBound(MyPaths) To UBound(MyPaths)
Set SourceWorkbook = OpenWorkbook(MyPaths(i)) 'this will set the workbook variable and open it
CopyData SourceWorkbook, DestinationWorkbook 'this will copy the data to your destination workbook
SourceWorkbook.Close , False
Set SourceWorkbook = Nothing
Next i
End Sub
Private Function OpenWorkbook(FullPath As String) As Workbook
Set OpenWorkbook = Workbooks.Open(FullPath, False, True)
End Function
Private Sub CopyData(wbO As Workbook, wbD As Workbook)
'this procedure calculates the last row of your source workbook and loops through all it's data
'later calls the AddDataToMasterWorkbook procedure to paste the data
With wbO.Sheets(1) 'Im assuming your source workbook has the data on sheet1
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Dim FilePath As String
FilePath = wbO.Path
Dim Code As String
Dim Description As String
Dim C As Range
For Each C In .Range("A2:A" & LastRow) 'this will loop from A2 to the last row with data
Code = Trim(C)
Description = Trim(C.Offset(, 1))
AddDataToMasterWorkbook wbD, FilePath, Code, Description
Next C
End With
End Sub
Private Sub AddDataToMasterWorkbook(wb As Workbook, FilePath As String, Code As String, Description As String)
'This procedure calculates the last row without data and adds the items you need every time
With wb.Sheets(1)
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow) = FilePath
.Range("B" & LastRow) = Code
.Range("C" & LastRow) = Description
End With
End Sub
To loop though files, you can indeed use a collection, or an array, you can also loop through all files in directory with certain extension, or partial file name. Check out DIR function.
Best not to use ActiveWorkbook, better approach would be to set a workbook object like so: Set wb = Workbooks.Open(fullPathToYourWorkbook).
For what you're doing, there's no need to go row by row, much more efficient way would be to copy entire range, not only it's a lot quicker but also it's only 1 line of code; assuming your destination is ThisWorkbook.Sheets(1) and wb object is set: wb.Range("A:C").Copy Destination:=Thisworkbook.Sheets(1).Range("A:C"). If you need to edit copied data (trim or whatever) consider Range Replace method.
However, if you want to go row by row for whatever reason, as BigBen mentioned in the comment - get rid of While loop.
It's a good idea to set Application.ScreenUpdating to False when opening/closing workbooks, then back to True once it's all done. It will prevent user from accidentaly clicking something etc and will make it look like it's not opening any workbook.
Here's my approach (untested) assuming the workbook you want to copy data to is Workbooks("Report.xlsm").Worksheets(1):
Sub Pulsante1_Click()
'set workbook object for the destination workbook
set wb_dest = Workbooks("Report.xlsm").Worksheets(1)
'disable screen updating
Application.ScreenUpdating = False
For Each target_wb In Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'set wb object and open workbook
Set wb = Workbooks.Open(target_wb)
'find last row in this workbooks in columns A:B (whichever is greater)
LastRow = wb.Range("A:B").Find(What:="*", After:=wb.Range("A1"), SearchDirection:=xlPrevious).row
'copy required data
wb.Range("A1:B" & LastRow).Copy Destination:=wb_dest.Range("B1:C" & LastRow)
'fill column A with path to the file
wb_dest.Range("A1:A" & LastRow).Value = wb.Path
'close workbook
wb.Close False
Next
'enable screen updating
Application.ScreenUpdating = True
End Sub
Obviously an array is not the best approach if you have loads of different files, collection would be a lot clearer to read and edit in the future, unless you want to create a dynamic array, but there's no need for that in my opinion. I didn't declare variables or write any error handling, it's a simple code just to point you in the right direction.
If you want to disable workbook events or/and alerts, you can set Application.DisplayAlerts and Application.EnableEvents to False temporarily.
I know this is a super generic error but I am new to VBA / Macros and cant get past this.
I have an and excel workbook that has data I need to copy to another excel workbook.
The excel workbook that the data is copied to is on a network share and will be written to frequently.
here is my macro code:
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
' Get the row from the workbook that we are running in
rowData = Workbooks().Worksheets(importSheet).Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = Workbooks(exportFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
' Assuming Workbooks() gets the current workbook.
Workbooks(exportFile).Sheets(exportSheet).Range(exportRange) = Workbooks().Sheets(importSheet).Range(importRange)
End Sub
My error is poping up on the rowData=Workbooks(exportFile).Worksheets
Can someone help me figure out what I am doing wrong?
Thank you,
Jennifer
Try your code with the following modifications, I'm just opening the workbook and referencing the worksheet (I guess the problem is that). I'm closing the workbook straight after.
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
'Open your workbook and point to your spreadsheet
Set wb = Workbooks.Open(exportFile)
Set ws1 = wb.Sheets(importSheet)
' Get the row from the workbook that we are running in
rowData = wb.ws.Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
'NOTE: consider definying the variable "exportSheet", I will do it just for example purpose
Dim exportSheet As String: exportSheet = "InputValues"
Set ws2 = wb.Sheets(exportSheet)
' Assuming Workbooks() gets the current workbook.
wb.ws2.Range(exportRange) = wb.ws1.Range(importRange)
wb.Close
End Sub