Display all available sheets in combobox, except the hidden ones, (loop through sheets add to list) VBA - vba

Okay genius hive mind, what am I doing wrong this time?
'wb and ws dimmed in module level declarations...
Set wb = ThisWorkbook
wb.activate
Dim I As Integer, sheetCount As Integer
sheetCount = wb.Worksheets.Count
Dim sheetNum As Integer
sheetNum = 1
With cboCopyFromSheet 'combobox
For I = 0 To sheetCount - 1
'not sure why the capital 'I' describing an object?
'copied from MS documentation
If wb.Worksheets(sheetNum).Visible = True Then
.AddItem wb.Worksheets(sheetNum).Name, I '<----Error
End If
sheetNum = sheetNum + 1
Next I
End With
Weirdly this only happens when I = 9 and sheetnum = 10
None of the sheets are currently hidden ( but some will be )
sheet 10 happens to be a blank sheet...
We are very confucius.
Error thrown is "invalid argument"
Any Clues?

A similar approach to Fane's answer, using the For Each statement.
Sub Whatever()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Visible Then combo.AddItem ws.Name
Next
End Sub

Try the next (simple) code, please. Creating the habit to use combobox List property, will be helpful when you will need to rapidly load a big range (multi-columns, too):
Sub testLoadComboSheetsNames()
Dim sh As Worksheet, arrSh As Variant, k As Long
ReDim arrSh(1 To ThisWorkbook.Worksheets.count)
For Each sh In ThisWorkbook.Worksheets
If sh.Visible = True Then k = k + 1: arrSh(k) = sh.Name
Next
ReDim Preserve arrSh(k)
cboCopyFromSheet.list = arrSh
End Sub
In order to work, your code must look like the next:
Sub testLoadComboShbis()
Dim i As Long, wb As Workbook
Set wb = ThisWorkbook
For i = 1 To wb.Worksheets.count
If wb.Worksheets(i).Visible = True Then
cboCopyFromSheet.AddItem wb.Worksheets(i).Name
End If
Next i
End Sub

Related

Split Worksheets

Currently this macro splits worksheets based on a cell.
It works well, however I am putting it as a button on a different page but this selects the active page, I want it to run this macro on a specific sheet.
Sub SplitToWorksheets_step4()
'Splits the workbook into different tabs
Dim ColHead As String
Dim ColHeadCell As Range
Dim icol As Integer
Dim iRow As Long 'row index on Fan Data sheet
Dim Lrow As Integer 'row index on individual destination sheet
Dim Dsheet As Worksheet 'destination worksheet
Dim Fsheet As Worksheet 'fan data worksheet (assumed active)
Again:
'ColHead = Worksheets("Diversion Report") 'this ask the user to enter a colunm name
ColHead = InputBox("Enter Column Heading", "Identify Column", [c1].Value) 'this ask the user to enter a colunm name
If ColHead = "" Then Exit Sub
Set ColHeadCell = Rows(1).Find(ColHead, LookAt:=xlWhole)
If ColHeadCell Is Nothing Then
MsgBox "Heading not found in row 1"
GoTo Again
End If
Set Fsheet = ActiveSheet
icol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To Fsheet.Cells(65536, icol).End(xlUp).Row
If Not SheetExists(CStr(Fsheet.Cells(iRow, icol).Value)) Then
Set Dsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Dsheet.Name = CStr(Fsheet.Cells(iRow, icol).Value)
Fsheet.Rows(1).Copy Destination:=Dsheet.Rows(1)
Else
Set Dsheet = Worksheets(CStr(Fsheet.Cells(iRow, icol).Value))
End If
Lrow = Dsheet.Cells(65536, icol).End(xlUp).Row
Fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(Lrow + 1)
Next iRow
End Sub
Function SheetExists(SheetId As Variant) As Boolean
' This function checks whether a sheet (can be a worksheet,
' chart sheet, dialog sheet, etc.) exists, and returns
' True if it exists, False otherwise. SheetId can be either
' a sheet name string or an integer number. For example:
' If SheetExists(3) Then Sheets(3).Delete
' deletes the third worksheet in the workbook, if it exists.
' Similarly,
' If SheetExists("Annual Budget") Then Sheets("Annual Budget").Delete
' deletes the sheet named "Annual Budget", if it exists.
Dim sh As Object
On Error GoTo NoSuch
Set sh = Sheets(SheetId)
SheetExists = True
Exit Function
NoSuch:
If Err = 9 Then SheetExists = False Else Stop
End Function
Change your Sub to:
Sub SplitToWorksheets_step4(SheetName as String)
and in the line:
Set Fsheet = ActiveSheet
to:
Set Fsheet = Worksheets(SheetName)
on a different page but this selects the active page, I want it to run
this macro on a specific sheet.
Well that is simple enough.
Set your Worksheet Object to a specific Sheet.Name - eg:
Dim Fsheet As Worksheet: Set Fsheet = Sheets("Your sheet name")
In a more practical usage, you could for example pass the sheet name as a procedure argument:
Private Sub SplitToWorksheets_step4(ByVal sheetName as String)
Dim fsheet as Worksheet: Set fsheet = Sheets(sheetName)
' ... do something
End Sub
Last but not least a practical way to apply a macro for every Worksheet:
Private Sub for_every_ws()
Dim ws as Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Range("A1") = "I was here!" ' i.e.
Next ws
End Sub

ComboBox trying to set selected item results in Compile error

I'm trying to select an item in a ComboBox in a UserForm. I found the .Selected(index)=True code almost everywhere but for me it sais:
Compile error: Method or data member not found.
My code:
Private Sub UserForm_Initialize()
Dim worksheetList As New ArrayList
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
worksheetList.Add ws.Name
Next ws
sourceWorksheets.List = worksheetList.toArray
destinationWorksheets.List = worksheetList.toArray
sourceWorksheets.Selected(1) = True 'Error here
End Sub
Am I doing something wrong? I couldn't really find any other function which would set the "default" item.
As #Rory keeps saying - use ListIndex to select an item in the list control.
This piece of code will add each sheet name to the list control and then select the first item:
Private Sub UserForm_Initialize()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Me.worksheetList.AddItem ws.Name
Next ws
Me.worksheetList.ListIndex = 0
End Sub
I think the OP was trying to use the code similar to below, but this still needs the ListIndex=0.
Private Sub UserForm_Initialize()
Dim ws As Worksheet
With CreateObject("System.Collections.ArrayList")
For Each ws In ThisWorkbook.Worksheets
.Add ws.Name
Next ws
Me.worksheetList.List = .ToArray
End With
Me.worksheetList.ListIndex = 0
End Sub
Edit: The code assumes the list control is called worksheetList.
Edit 2: A slightly different version. It reverses the items in the list when you click the form.
It's still Me.worksheetList.ListIndex = 0 to select the item in the list control though.
Option Explicit
Public MyArrayList As Variant
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Set MyArrayList = CreateObject("System.Collections.ArrayList")
With MyArrayList
For Each ws In ThisWorkbook.Worksheets
.Add ws.Name
Next ws
.Sort
Me.worksheetList.List = .ToArray
End With
Me.worksheetList.ListIndex = 0
''This will only work in a listbox, not a combobox.
''Select items in row numbers that are even (ListIndex 0,2,4, etc)
''MultiSelect must be 1 - fmMultiSelectMulti or 2 - fmMultiSelectExtended
' Dim x As Long
' For x = 0 To Me.worksheetlist.ListCount - 1
' If x Mod 2 = 0 Then
' Me.worksheetlist.Selected(x) = True
' End If
' Next x
End Sub
Private Sub UserForm_Click()
With MyArrayList
.Reverse
Me.worksheetList.List = .ToArray
End With
Me.worksheetList.ListIndex = 0
End Sub
To check whether particular element (indicated by index) is selected you should do workaround like this:
ComboBox1.Value = ComboBox1.List(i)
where i is given index. It has to be done like that, because there is no propertry like SelectedIndex in VBA ComboBox.
Keep in mind, that indexing starts with 0 !

Excel 2016: VBA code in one workbookwill affect cells in other workbooks

I've used the same code in Excel 2013 and Excel 2010, it works perfectly fine, but when the system upgraded to Excel 2016, things changed, code works in one book will be implemented in other workbook if I type words in that workbook, any idea? thanks a lot
here is the part of the code
```
Sub createsheets()
On Error Resume Next
Dim sh As Worksheet
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Workbooks("Book2").Worksheets
If ws.Name <> "test" Then ws.Delete
Next
For j = 4 To 10
PauseTime = 5
starter = Timer
Do While (Timer < starter + PauseTime)
Application.StatusBar = "do nothing..."
DoEvents
Loop
Application.StatusBar = ""
Workbooks("Book2").Worksheets.Add.Name = "name" & j - 3
current_worksheet_name = "name" & j - 3
Workbooks("Book2").Worksheets(current_worksheet_name).Cells(1, 1) = "this is a test"
Next
End Sub
```
***for this code, if i type words in another workbook, say the workbook name is "ABC", new sheets with name "namej" will be created in my current workbook"ABC".
which is apparently unacceptable, I think i've specified the workbook , but it still doesn't work
You may try something like this...
Sub createsheets()
Dim wb As Workbook
Dim sh As Worksheet
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks("Book2.xlsx")
If Not wb Is Nothing Then
On Error Resume Next
For Each ws In wb.Worksheets
If LCase(ws.Name) <> "test" Then ws.Delete
Next
For j = 1 To 7
wb.Sheets.Add(after:=Sheets(Sheets.Count)).Name = "name" & j
Set sh = ActiveSheet
sh.Cells(1, 1) = "this is a test"
Next
Else
MsgBox "Book2.xlsx is not opened.", vbExclamation
End If
Application.ScreenUpdating = True
End Sub

Looping though a list of sheets

I am trying to loop through a list of (randomly named) worksheets and for each calculate the last row and then loop though all the rows and execute some code.
I've tried the code below but I'm getting Invalid Procedure Call or Argument. I've modified in all kinds of ways but it's driving me crazy...thank you in advance.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
rcount = .Worksheets(ws).Cells("A1").End(xlDown).Row
For i = 1 To rcount
If ...Then
End If
Next
Next
End With
End Sub
#Santosh makes a great point about finding the last row. As for the original question, in any Workbook there exists a Worksheets collection that might actually be easier to loop through depending on your structure:
Dim ws As Worksheet
For Each ws In Worksheets
'match worksheet names if necessary using ws.Name...
'
'do other cool stuff...
'
'wrap it all up
Next ws
Try this. Instead of going to cell A1 and going down to find the last row its better to go to last cell (rows.count) and then go up.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
With .Worksheets(ws)
rcount = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To rcount
'If .. Then
End If
Next
Next
End With
End Sub

Skip PERSONAL.xlsb workbook while ListWorkbooks

I have a code to List out all the open workbooks, since all my codes are in Personal.xlsb it also get listed, can anyone tell me an If condition to skip the Personal.xlsb from the list.
And also since Personal.xlsb dose not have a "Data_Index" it tends to give an error for that too
Sub ListWorkbooks()
Dim Wb As Workbook
For j = 1 To Workbooks.Count
Sheets("Data_Index").Select
Range("H3").Cells(j, 1) = Workbooks(j).Name
For i = 1 To Workbooks(j).Sheets.Count
Next i
Next j
End Sub
Sub ListWorkbooks()
Dim Wb As Workbook
Dim i As Integer, j As Integer
For j = 1 To Workbooks.Count
If Workbooks(j).Name <> ThisWorkbook.Name Then
Workbooks(j).Sheets("Data_Index").Range("H3").Cells(j, 1) = Workbooks(j).Name
End If
'not sure what you want to do here
For i = 1 To Workbooks(j).Sheets.Count
Next i
Next j
End Sub
Revised Answer
From reading your comments on other answers you need to also identify which of the open workbooks has a worksheet named Data_Index as well, which is why you were getting a subscript out of range (your code assumed that every workbook had a sheet named Data_Index.
This works for me when I test:
Sub ListWorkbooks()
Dim Wb As Workbook, wb2 As Workbook
Dim sht As Worksheet
Dim c As Range
'Identify which (if any) of the open workbooks has sheet Data_Index
'Note if more than one it will pick the last one it finds
On Error Resume Next
For j = 1 To Workbooks.Count
Set sht = Workbooks(j).Sheets("Data_Index")
Next j
On Error GoTo 0
'Check at least one has the required sheet
If sht Is Nothing Then
MsgBox "There is no open workbook with a sheet named Data_Index", vbExclamation
Else
'Set the destination for the first workbook name
Set c = sht.Range("H3")
For j = 1 To Workbooks.Count
If Workbooks(j).Name = "Personal.xlsb" Then GoTo NextWb
c.Value = Workbooks(j).Name
For i = 1 To Workbooks(j).Sheets.Count
' Whatever you want to do cycling sheets
Next i
'Offset to the next row ready for the next name
Set c = c.Offset(1, 0)
NextWb:
Next j
End If
End Sub
You could do this using arrays, but the above will do it for you.