In VBA, I know it's possible to loop through worksheets like so:
for i = 1 to 5
msgbox worksheets(i).cells(1,1)
next
which pulls the first 5 sheets (in order from left to right) in the workbook. How can I reference the sheet's codenames instead? As in the first worksheet in the workbook might be Sheet10, the second Sheet6, etc...So if I'm trying to loop using sheet#s (codenames), is that possible?
You can create your own collection of worksheets that you can index by the code-name. This function does that:
Function SheetsByCodeName() As Collection
Dim sh As Worksheet
Set SheetsByCodeName = New Collection
For Each sh In ThisWorkbook.Worksheets
SheetsByCodeName.Add sh, sh.CodeName
Next
End Function
and then you can use it for your indexing, like so:
dim sheetsByCN as Object: Set sheetsByCN = SheetsByCodeName
dim cn
For each cn in Array("Sheet10","Sheet11","Sheet22","Sheet5","Sheet1")
debug.print sheetsByCN(cn).Cells(1,1).value
Next
The is no indexer on codeName so you have to loop through the sheets yourself.
A very basic example would be something like this:
Public Sub FindSheets()
Dim i As Integer
Dim objSheet As Worksheet
For i = 1 To 5
Set objSheet = FindSheetByName("Sheet" & i)
If objSheet Is Nothing Then
MsgBox "No sheet with codename Sheet" & i
Else
MsgBox objSheet.Name & " has codename " & objSheet.CodeName
End If
Next
End Sub
Function FindSheetByName(ByVal v_strCodeName As String) As Worksheet
Dim objSheet As Worksheet
Set FindSheetByName = Nothing
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.CodeName = v_strCodeName Then
Set FindSheetByName = objSheet
Exit Function
End If
Next
End Function
No, it's not possible to index sheets by their CodeName.
You can either loop all sheets and check their CodeName, or use a separate method:
Sub processSheet(ws As Worksheet)
Debug.Print ws.Cells(1)
End Sub
Sub process()
processSheet(Sheet10)
processSheet(Sheet11)
processSheet(Sheet12)
End Sub
Another alternative might be (not tested):
For Each ws In Array(Sheet10, Sheet11, Sheet12)
Debug.Print ws.Cells(1)
Next
If the sheets called Sht1, Sht2, ,, Sht5
Then
for i = 1 to 5
msgbox worksheets("Sht" & i).cells(1,1)
next
Related
The first sub collects all the worksheets of the workbooks that are located in D:\Users\Cons\excel.
Then the second sub looks for the word "filename" in worksheet 2 then copies all the cells below to A2 in worksheet 3.
Finally the last sub should search for the word "apple" in e2:e100 in worksheet 3, and delete every row where "apple" is not found.
I have created 3 buttons and assigned the subs to each one of them. The first 2 runs fine, doing what I want, but when I click on the 3rd button (with 3rd sub behind), nothing happens,
only the first two buttons above are being shifted upwards, don't know why.
How can I combine all the 3 subs into one (that is actually working with a button click)? Thanks in advance!!!
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "D:\Users\Cons\excel\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
Worksheets(1).Activate
End Sub
Sub FindInFirstRow()
Dim fCell As Range
Dim strFind As String
Dim wsSource As Worksheet
Dim wsDest As Worksheet
'What shall we look for?
strFind = "filename"
'What sheet are we getting data from/to?
Set wsSource = Worksheets(2)
Set wsDest = Worksheets(3)
Set fCell = wsSource.Range("1:1").Find(what:=strFind, lookat:=xlPart, MatchCase:=False)
If fCell Is Nothing Then
MsgBox "No match found"
Else
'Copy the cells *below* to A2 of destination sheet
Intersect(wsSource.UsedRange.Offset(1), fCell.EntireColumn).Copy wsDest.Range("a2")
End If
End Sub
Sub SaveSomeRows()
Dim N As Long, L As Long, r As Range
Dim s As String, v As String
Set r = ActiveSheet.Range("e2", ActiveSheet.Range("e100").End(xlUp))
N = r.Count
s = "apple"
For L = N To 1 Step -1
v = LCase(r(L).Value)
If InStr(1, v, s) = 0 Then
r(L).EntireRow.Delete
End If
Next L
End Sub
Sub TheOneSub()
ConslidateWorkbooks
FindInFirstRow
SaveSomeRows
End Sub
Sub ConslidateWorkbooks()
...
End Sub
Sub FindInFirstRow()
...
End Sub
Sub SaveSomeRows()
...
End Sub
Sub combine_all()
Call ConslidateWorkbooks
Call FindInFirstRow
Call SaveSomeRows
'Runs them sequentially
End Sub
Assign this to a button , this would run (call) the other codes in sequence
Its been a long time. I need a VBA to name my sheets Test 1, Test 2 etc from the active sheet and all to the right.
OR do the same for all selected sheets. IE, I'd select a block of 10 sheets and run my macro to rename them "Test 1,...Test 10"
it doesn't matter which method but there are sheets that I don't want the names changed so I either need the following to work ONLY on a block of selected sheets OR from an active sheet and all to the right.
I'm working from the following code:
Sub nameShts()
Dim i As Integer
For i = 1 To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
You were close for idea to loop from selected sheet to last sheet. Instead of 1 to Worksheets.Count use ActiveSheet.Index to Worksheets.Count
Sub nameShts()
Dim i As Integer
For i = ActiveSheet.Index To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
To loop the selected sheets, use ThisWorkbook.Windows(1).SelectedSheets to get a collection of the selected sheets.
Then simply loop the collection.
Select your desired sheets and run this:
Sub nameShts()
Dim i As Integer
i = 1
Dim sh As Worksheet
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
sh.Name = "Week" & i
i = i + 1
Next sh
End Sub
It will only change the sheets selected
Worksheet.Next seems like a good fit for this problem
Sub nameShts()
Dim ws As Worksheet
Set ws = ActiveSheet
Do
ws.Name = "Test " & (ws.Index - ActiveSheet.Index + 1)
Set ws = ws.Next
Loop While Not ws Is Nothing
End Sub
So I have a pivottable and in column C there is field for which I am showing details for each record using this
For i=7 to 10
DATA.Range("C" & i).ShowDetail = True
Set wN = ThisWorkbook.Worksheets(1)
Next i
Now it works fine but the problem is Set wN = ThisWorkbook.Worksheets(1) assigns the wN the first worksheet but DATA.Range("C" & i).ShowDetail = True sometimes inserts the new worksheet which has the details at 1st or 2nd position. Now I want to know which was the new worksheet which was inserted and assign wN to it.
Do I have to make an array or list which keeps record of existing worksheets and then check which is the new one everytime? or there is an easy way to determine which is the newest worksheet in an workbook irrespective of the position.
Look at the Activesheet. ShowDetail creates the new sheet and activates it - so Set wn=ActiveSheet should work.
Sub Test()
Dim c As Range
Dim wrkSht As Worksheet
With ThisWorkbook.Worksheets("Sheet2").PivotTables(1)
For Each c In .DataBodyRange.Resize(, 1)
c.ShowDetail = True
Set wrkSht = ActiveSheet
Debug.Print wrkSht.Name
Next c
End With
End Sub
This link to Jon Peltiers page on Pivot Tables should be a massive help... https://peltiertech.com/referencing-pivot-table-ranges-in-vba/
The code shown does not add a worksheet, it sets wN to whatever sheet has index 1 (The second sheet created).
Try wN.Name = "C"& i & " field" to help figure out when each sheet is being created.
Open a new Workbook. Then run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsNew As Worksheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsNew = Worksheets(Worksheets.Count)
Debug.Print wsNew.Name
End Sub
You would see, that wsNew is always the last one added. Thus with Worksheetes(Worksheets.Count) you may access it.
Edit:
If you want to know the name of the last added Worksheet, without adding After:, then use collection to remember all the worksheets you had before and simply compare them with the new collection. Run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsCollection As New Collection
Dim lngCounter As Long
Dim strName As String
Dim blnNameFound As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
wsCollection.Add ws.Name
Next ws
Worksheets.Add
For Each ws In Worksheets
blnNameFound = False
For lngCounter = 1 To wsCollection.Count
If wsCollection.Item(lngCounter) = ws.Name Then
blnNameFound = True
End If
Next lngCounter
If Not blnNameFound Then Debug.Print ws.Name
Next ws
End Sub
The complexity is O².
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I need to cycle through sheets of index 3 tip last sheet and run a code. I tried something like this but its doesn't work.
If (ws.sheetIndex > 2) Then
With ws
'code goes here
End With
End If
I did a search but don't find a solution to this problem. Help would be much appreciated.
I also tried:
Dim i As Long, lr As Long
Dim ws As Worksheet
Windows("Book1").Activate
With ActiveWorkbook
Set ws = .Worksheets("index")
For i = 3 To 10
'code goes here
Next i
End With
You can try the following, which iterates over all worksheets in your workbook and only "acts" for worksheets with index 3 or above.
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Index > 2 Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(1, 1).Value = "hi"
End If
Next
Note that this doesn't put a hard limit on the number of sheets you have (10 or whatever), as it will work with any number of worksheets in your active workbook.
EDIT
If you want the code to run on worksheets with names "Sheet" + i (where i is an index number from 3 onwards), then the following should help:
Dim sheet As Worksheet
Dim i As Long
For i = 3 To ActiveWorkbook.Worksheets.Count
Set sheet = ActiveWorkbook.Worksheets(i)
If sheet.Name = "Sheet" & i Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(2, 2).Value = "hi"
End If
Next i
Of course, this means that the names of your worksheets need to always follow this pattern, so it's not best practice. However, if you're sure the names are going to stay like this, then it should work well for you.
Try excluding first and second sheet using name:
Public Sub Sheets3andUp()
Dim ws As Worksheet
Dim nameOfSheet1 As String
Dim nameOfSheet2 As String
nameOfSheet1 = "Sheet1"
nameOfSheet2 = "Sheet2"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> nameOfSheet1 And ws.Name <> nameOfSheet2 Then
'Code goes here
Debug.Print ws.Name
End If
Next ws
End Sub
Note that the user can reorder the sheets in the Worksheets Collection, so it is better to refer to the sheets by CodeName (which the user cannot change), and exclude by CodeName the sheets to be skipped, as here:
Public Sub TestLoop()
On Error GoTo ErrHandler
Dim ws As Worksheet, s As String
For Each ws In Worksheets
If ws.CodeName <> "Sheet2" Then
s = s & vbNewLine & ws.CodeName
End If
Next ws
s = "WorksheetList (except Sheet2:" & vbNewLine & vbNewLine & s
MsgBox s, vbOKOnly, "Test"
EndSUb:
Exit Sub
ErrHandler:
Resume EndSUb
End Sub
If I drag Sheet 3 to precede Sheet1, the MsgBox outputs:
WorksheetList (except Sheet2:
Sheet3
Sheet1