So far, I have created a button "AddaSheet" which pops up a userform where a name "NewSheetName" can be inserted in a text box. Then I have a button ("AddNow") which when clicked, needs to (and this is where I need help) do the following:
copy the "Template" sheet and rename it as "NewSheetName" (so the inputted text) and insert this new sheet alphabetically between two defined sheets.
I have many sheets in my workbook with different elements such as tables and so on, and I have grouped a particular kind of data set sheets together. As such, Ideally, if the new sheet can be inputted between a set range, it would be great.
Thank you in advance for your help!
p.s. I am a beginner, I would really appreciate if you could explain with comments what the code is doing.
This will sort your sheets into alphabetical order
Sub SortSheetsTabName()
' Turn off screenupdating so no visual effects to enduser
Application.ScreenUpdating = False
Dim iSheets%, i%, j%
' Get number of sheets in workbook
iSheets = Sheets.Count
' Loop through all sheets in workbook
For i = 1 To iSheets - 1
' Loop through sheets to find correct position of worksheet
For j = i + 1 To iSheets
' Test position
If Sheets(j).Name < Sheets(i).Name Then
' Move sheet to alphabetical position
Sheets(j).Move before:=Sheets(i)
End If
Next j
Next i
' Turn on screenupdating for end user
Application.ScreenUpdating = True
End Sub
Source
If you need to insert the new sheet alphabetically between two defined sheets. For example between a sheet called Start and a sheet called End then use the following code.
The advantage of this code is that there can be a alphabetically random order of sheets before Start and after End but only the new template sheet gets sorted in the correct way.
Example:
In the following sheets the new Delta sheet will be sorted in between Beta and Epsilon but the rest of the order is completely random:
Option Explicit
Public Sub CopyAndSortSheetInBetween()
Dim wsTemplate As Worksheet 'template sheet
Set wsTemplate = ThisWorkbook.Worksheets("Template")
Dim iStart As Long 'define your start sheet
iStart = ThisWorkbook.Sheets("Start").Index + 1
Dim iEnd As Long 'define your end sheet
iEnd = ThisWorkbook.Sheets("Stop").Index - 1
If iEnd < iStart Then
MsgBox "Stop sheet is before start sheet"
Exit Sub
End If
Dim NewName As String 'name that your new sheet will be
NewName = "Delta"
'find out which position is between "Start" and "Stop" sheet is the correct
Dim i As Long
For i = iStart To iEnd
If UCase(ThisWorkbook.Sheets(i).Name) > UCase(NewName) Then
Exit For
End If
Next i
'now i is the destination sheet number for your copied template sheet
'and you can copy and rename your template
wsTemplate.Copy Before:=ThisWorkbook.Sheets(i)
ThisWorkbook.Sheets(i).Name = NewName
End Sub
Related
I'd like to loop through particular worksheets in Excel Tab >>> and <<< Tab and insert a new row and paste special values.
The below code allows one to loop through all worksheets but I am unsure how to loop between specific worksheets - i.e. For Each tab between two tabs only and not including - Tab >>> and <<< Tab.
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert new row here and paste special values
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
Dim i As Long
For i = ThisWorkbook.Worksheets("Tab >>>").Index + 1 To ThisWorkbook.Worksheets("<<< Tab").Index - 1
With ThisWorkbook.Worksheets(i)
MsgBox .Name
.Rows(11).Insert, xlFormatFromLeftOrAbove
End With
Next
Dim i As Long
For i = ThisWorkbook.Worksheets("Tab >>>").Index + 1 To ThisWorkbook.Worksheets("<<< Tab").Index - 1
MsgBox ThisWorkbook.Worksheets(i).Name
ThisWorkbook.Worksheets(i).Rows(11).Insert , xlFormatFromLeftOrAbove
Next
I have created the following Excel-spreadsheet:
A B C D E
1 Sheet1
2 Sheet2
3 Sheet5
4 Sheet6
5 Sheet8
6 Sheet9
7
As you can see, in Column A I have listed some of the sheets within the Excel file.
Now, I use the below VBA to get this list into a ComboBox:
Sub UserForm_Activate()
ComboBox1.List = Sheet1.Range("A1:A8").Value
End Sub
All this works fine so far.
However, now it can happen that some of the sheets are not visible. Therefore, I also do not want them to appear in the ComboBox.
One solution I found was the answer from here. However, this VBA only works over the entire Excel file but as you can see in my list above some sheets (Sheet3, Sheet4, Sheet7) are excluded from the list. Those sheets should also remain excluded no matter if they are visible or not.
So for example, when I make Sheet2 and Sheet6 invisible the list in the ComboBox should automatically be adjusted and look like this:
Sheet1
Sheet5
Sheet8
Sheet9
What do I need to change in my VBA to achieve this?
The code below puts the sheets from the worksheet into a dynamic array and checks if it's visible, so you're not hard-coding the visible sheets. Therefore, excluding the sheets you don't want (Sheet3, Sheet4 and Sheet7) from the worksheet will also exclude them from your ComboBox.
Private Sub UserForm_Activate()
Dim sheet_list As Variant
sheet_list = Sheet1.Range("A1:A8").Value
'get the list of Sheets from Column A
Dim combo_list As Variant
combo_list = Array()
'create and empty array
Dim sheet_name As Variant
For Each sheet_name In sheet_list
'loop through sheets
If ThisWorkbook.Worksheets(sheet_name).Visible Then
'check if they are visible
Dim ub As Long
ub = UBound(combo_list) + 1
ReDim Preserve combo_list(ub)
'increment array dimension
combo_list(ub) = sheet_name
'add Sheet to array
End If
Next sheet_name
ComboBox1.List = combo_list
'populate the ComboBox
End Sub
Based on linked topic I modified the code from answer to reach what You want to achieve
Private Sub ChangeComboBox()
Dim xSheet As Worksheet
' Clear the combobox
ComboBox1.Clear
' Add the sheets again
For Each xSheet In ThisWorkbook.Sheets
'~~> Check if they are visible
If xSheet.Visible = xlSheetVisible Then
If xSheet.Name <> Sheet3.Name And xSheet.Name <> Sheet4.Name And xSheet.Name <> Sheet7.Name Then
ComboBox1.AddItem xSheet.Name
End If
End If
Next
End Sub
I have set up a VBA macro that is running a VBA operation consecutively in each spreadsheet of a given Excel file. Given that there are numerous sheets in the file, which leads to occasional interruptions with the server, I have to restart the request every once in a while.
So here comes the question: I am looking to modify the code element below in a way that the VBA macro starts running on the currently selected sheet/tab. It shall then consecutively cover all remaining sheets/tabs to the right of the active sheet, but not those to the left which have already been populated.
The code below restarts the each run of the macro with the very first sheet/tab of the file, which is not necessary. Is there any smart tweak to the code?
Dim xsheet As Worksheet
For Each xsheet In ThisWorkbook.Worksheets
xsheet.Select
There are three sheet-specific collections: Worksheets, Charts and DialogSheets. The Index property of these collections returns Sheets's collection index - not the actual index in sheet-specific collection.
Say, you have four sheets:
Worksheet ("Sheet1")
Worksheet ("Sheet2")
Chart ("Chart1")
Worksheet ("Sheet3").
In this case Worksheets("Sheet3").Index returns 4 when the real index is 3. The bottom line is never rely on Index property of sheet-specific collection when it comes to processing all the sheets.
To solve you problem you just need to use Sheets collection:
Sub FFF()
Dim x%, sheet As Variant
For x = ActiveSheet.Index + 1 To Sheets.Count
Set sheet = Sheets(x)
'// Do something with sheet
Next
End Sub
Continue Through Worksheets
If you want to continue with the ActiveSheet, just remove ' + 1'.
Warning: These codes are valid if you only have worksheets in the workbook, and not charts, dialogs or whatever.
I almost always use only worksheets in my workbooks so I never learned about the Index issue that JohnyL is referring to in his answer to this question.
The Idea
Sub ContinueThroughWorksheets()
Dim i As Long
With ThisWorkbook
For i = .ActiveSheet.Index + 1 To .Worksheets.Count
Debug.Print .Worksheets(i).Name
Next
End With
End Sub
The Implementation
Sub ContinueThroughWorksheets2()
Dim i As Long
Dim j As Long
With ThisWorkbook
Select Case .ActiveSheet.Index
Case 1
j = 1
Case .Worksheets.Count
Exit Sub
Case Else
j = .ActiveSheet.Index + 1
End Select
For i = j To .Worksheets.Count
Debug.Print .Worksheets(i).Name
Next
End With
End Sub
You can do it thus, but note that it's generally not advisable to base code on the active sheet or active cells as they can easily be changed and your code may not run correctly.
A better method would be to store the (code)names of the sheets processed elsewhere and loop through your sheets excluding those names.
Sub x()
Dim i As Long
For i = ActiveSheet.Index To Worksheets.Count
MsgBox Worksheets(i).Name
Next i
End Sub
I need help to create an automatic method to copy a row to a specific sheet.
I have a Tab (Sales) with a WEB api query importing data in this sheet every 5 min. I have a row within the Sales sheet with a name range identifying each item. The row has 100 different names and there are 100 sheets created with same names within the workbook.
I want to copy the entire row for each item and copy it to the sheet with the same name of the item.
This is to fire off the copy sub:
'Copy Sales data Every 10 Min
Sub test()
'Application.OnTime Now + TimeValue("00:10:00"), "my_Procedure…"
End Sub
I have seen many methods on how to copy the row automatically, but I need help in copy row and use the item name and paste to other sheet with same name.
Without further information here is an outline of what i described in the comments. Here the list of named ranges starts at cell J3 in NamesSheet. In the image, i have shown it in the same sheet (SourceSheet for simplicity). The list is read into an array and that array is looped to select the appropriate sheet to set the values in.
Rather than copy and paste it sets the target row (the next available row), in the sheet accessed by the array index, equal to the source row (copyRow). A With statement is used to avoid selecting the target sheet (more efficient).
No error handling added for missing sheets at present.
I haven't assumed there will be a list of 100 named ranges in the sheet, otherwise you could have sized the array from the start.
Named ranges in ColA of Sales tab:
List of named ranges in Names sheet (abbreviated)
Option Explicit
Private Sub myProc()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsNames As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Set wsNames = wb.Worksheets("Names")
Dim namesArr()
namesArr = wsNames.Range("J3:J" & wsNames.Cells(wsNames.Rows.Count, "J").End(xlUp).Row).Value
If UBound(namesArr, 1) <> wsSource.Range("ITEMName").Rows.Count Then
MsgBox "There are not a matching number of named ranges listed in Names sheet."
Exit Sub
End If
Dim i As Long
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
For i = LBound(namesArr, 1) To UBound(namesArr, 1)
With wb.Worksheets(namesArr(i, 1))
Set copyRow = wsSource.Range(namesArr(i, 1)).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Version 2:
Looping Named Ranges in Sales sheet (assumes only 101 Named Ranges in the sheet, tested with workbook scope, and that you will ignore 1 of these which is called ITEMName, no list required in a different sheet. Approach adapted from #user1274820.
Option Explicit
Private Sub myProc2()
Dim wb As Workbook
Dim wsSource As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
Dim nm As Variant
For Each nm In ThisWorkbook.Names
If nm.RefersToRange.Parent.Name = "Sales" And nm.Name <> "ITEMName" Then
With wb.Worksheets(nm.Name)
Set copyRow = wsSource.Range(nm.Name).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
End If
Next nm
Application.ScreenUpdating = True
End Sub
Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.
My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.
An example for the sake of clarity:
In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".
In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".
In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".
We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.
Is this possible?
Here are two VBA solutions. The first does this:
Check if a sheet "totals" exists. Create it if it does not
Copy the first row (A to Q) of first sheet to "totals"
Copy block A2:Q33 to "totals" sheet starting at row 2
Repeat for all other sheets, appending 32 rows lower each time
The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.
Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .
Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = ActiveWorkbook.Sheets("totals")
End If
Set targetRange = newSheet.[A1]
' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> newSheet.Name Then
ws.Range("A2", "Q33").Copy targetRange
Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
End If
Next ws
End Sub
Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = Sheets("totals")
End If
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
For Each ws In ActiveWorkbook.Worksheets
' don't copy data from "total" sheet to "total" sheet...
If ws.Name <> newSheet.Name Then
' copy the month label
ws.[A2].Copy targetRange
' get the sum of the coluns:
Set columnToSum = ws.[B2:B33]
For colNum = 2 To 17 ' B to Q
targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
Next colNum
Set targetRange = targetRange.Offset(1, 0) ' next row in output
End If
Next ws
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function
Final(?) edit:
If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChange event by adding code to the workbook. You do this as follows:
open the Visual Basic editor ()
In the project explorer (left hand side of the screen), expand the VBAProject
Right-click on "ThisWorkbook", and select "View Code"
In the window that opens, copy/paste the following lines of code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' handle errors gracefully:
On Error GoTo errorHandler
' turn off screen updating - no annoying "flashing"
Application.ScreenUpdating = False
' don't respond to events while we are updating:
Application.EnableEvents = False
' run the same sub as before:
aggregateRaw
' turn screen updating on again:
Application.ScreenUpdating = True
' turn event handling on again:
Application.EnableEvents = True
Exit Sub ' if we encountered no errors, we are now done.
errorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
' you could add other code here... for example by uncommenting the next two lines
' MsgBox "Something is wrong ... " & Err.Description
' Err.Clear
End Sub
Kindly use RDBMerge add-in which will combine the data from different worksheet and create a master sheet for you. Please see the below link for more details.
http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html
Download RDBMerge
You can use the indirect function to reference the sheet name. In the image below this function takes the header name (B37) and uses it as the sheet reference. All you have to do is choose the correct "total cell" which I made "A1" in "MAY_2013". I put an image below to show you my reference name as well as tab name