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
Related
i have an Workbook with 5 Sheets where you can add Data while Using a Userform. The Data begins in each Sheet in row 10, since i nead the rows above 10 for my interface. I have also an Mastersheet, where the Data from these specific Sheets should be copied and should be edited if needed by DoubleClick and an Unserform. I Managed to write the Code for Copying the Data from these Sheets, but I also need the Sheetname next to the Data in Column A, so it's clear where the Data is from. The Data begins also in Row 10 of the Mastersheet.
1.Problem: Can't get the Sheet names in Column A and the Data to start in Column A.
2. If one Sheet is empty it Copies the Headers into the Mastersheet
3. By Double Click in the Row my Userform doesn't appear.
When i write The Sheet Name in Column B of the Mastersheet, the Data gets edited. But The Mastersheet should refresh itself when the editing is done
I would really appreciate if someone could help me, since i just startet with vba and don't know What to do.
`
Private Sub Worksheet_Activate()
Dim Ws As Worksheet
Me.Rows("6:" & Rows.count).Clear
Me.Range("A9:Z9").Value = Array("Markt".... (And So on)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Summary" And Ws.Name <> "Startseite" And Ws.Name <> "Agenda" (And so on) Then
Ws.Rows("10:" & Ws.Cells.Find("*", searchdirection:=xlPrevious).Row).Copy Me.Range("A" & Me.Cells.Find("*", searchdirection:=xlPrevious).Row + 1)
End If
Next Ws
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim Sheet As String
Dim POS As Integer
Cancel = True
If Range(Target.Address).Row >= 10 Then
Sheet = Cells(Target.Row, 2).Value 'Get The Sheet Name from Column B I could change that bu I need the Sheet name in a Column to do that
If IsNumeric(Cells(Target.Row, 1).Value) Then
POS = CInt(Cells(Target.Row, 1).Value)
Else
POS = 0
End If
Else
Exit Sub
End If
If POS = 0 Then
Exit Sub
Else
Sheets("Code").Range("G2") = Sheet
Sheets("Code").Range("G3") = POS
End If
Edit.Show
End Sub
`
I tried changing the code but it didn't work
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
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
I'm looking for a way to add the sheetnames to my combobox.
Final result should be:
2 combo boxes next to each other were in the first box I can enter the sheetname and with the second box data from the sheet I just selected.
Thanks!
As a starting point, do the following:
Starting with a new Workbook, add 2 ComboBoxes to Sheet1, then add this code to the 'ThisWorkbook' code module:
Private Sub Workbook_Open()
Dim ws As Worksheet
'iterate through all worksheets and add each one to the combobox
For Each ws In Worksheets
Sheet1.ComboBox1.AddItem ws.Name 'add sheet name to combobox
Next ws
End Sub
Then add this code to the 'Sheet1' code module:
Private Sub ComboBox1_Change()
Dim i As Integer
If ComboBox1.Value <> "" Then
ComboBox2.Clear 'clear out the combobox
'add values from A1 to A5 to ComboBox2 from selected worksheet
For i = 1 To 5
ComboBox2.AddItem Worksheets(ComboBox1.Value).Range("A" & i).Value
Next i
End If
End Sub
Use the above code as a starting point, read each line and research what you don't understand until you can explain what each line does. Then you will be able to use the same concept in your solution.
I'm initializing a userform in an Excel VBA macro. When I go to populate the items in a combobox, I get stuck in an infinite loop, but I don't know why. Here is my code:
Private Sub UserForm_Initialize()
'Populate the combobox with the months
Me.cboCurrMth.SetFocus
Dim cMth As Range
Dim ws As Worksheet
Set ws = Sheet1
For Each cMth In ws.Range("months")
With Me.cboCurrMth
.AddItem cMth.Value
.List(.LineCount - 1, 1) = cMth.Offset(0, 1).Value
End With
Next cMth
End Sub
The named range "months" includes all 12 rows and 2 columns where the first column is an integer (from 1 to 12) and the second column is the string name of each month.
Anyone see why this loop won't terminate? Thanks.
You should rarely select cells or ranges in your production VBA code. However, it can be extremely helpful for debugging purposes.
Add a .select in your For Each loop and then step through your code. You should be able to figure out what's wrong.
Private Sub WhyAmIInfinite()
'Loop through and select the months
Dim cMth As Range
Dim ws As Worksheet
Set ws = Sheet1
For Each cMth In ws.Range("months")
cMth.Select
Next cMth
End Sub
I set up a worksheet with a range exactly as you describe and the loop exited as I expected it to. I removed the combobox from my example because I wanted to isolate the loop itself.
I have wrote the following code and it is worked for me. I am using Excel 2003.
ActiveSheet.Shapes("cmbMonths").Select
Dim currMonth As Range
With Selection
For Each currMonth In Range("Months")
.AddItem currMonth.Value
Next
End With
This line ".List(.LineCount - 1, 1) = cMth.Offset(0, 1).Value" is giving error for me 'Saying member not found"
Please select your month cells once again and give the name for the selected range and try again.
Hope it works.