Unable to assign value to an array - excel

I'm trying to clear values in the sheets that are present in a workbook. I have a list of all possible (valid) sheets, but I won't know which sheet is currently present in the workbook. So, I need to get the worksheets' name, see if it's valid and then clear its contents. Here's what I have so far:
Sub testclear()
Dim validsheets() As Variant, sheetstoclear() As Variant
Dim i as Integer, j As Integer, k As Integer, m as Integer
validsheets() = Array ("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
For i = 1 To Worksheets.count
For j = LBound(validsheets) to UBound(validsheets)
If Worksheets(i).Name = validsheets(J) Then
sheetstoclear(k) = Worksheets(i).Name
k = k +1
End If
Next j
Next i
For m = LBound(sheetstoclear) to UBound(sheetstoclear)
Sheets(sheetstoclear(m+1)).Cells.clear
Next m
End Sub
If I execute the above code, I get the following error -
Run-time error'9':
Subscript out of range

Iterate the sheets collection and clear the sheet directly without creating a sheetstoclear array first.
Option Explicit
Sub testclear()
Dim ws As Worksheet, validsheets, var
validsheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
For Each ws In ThisWorkbook.Sheets
For Each var In validsheets
If var = ws.Name Then
ws.Cells.Clear
Exit For
End If
Next
Next
End Sub

Please, try the next simple way:
Dim ws As Worksheet
For Each ws In Worksheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5"))
ws.UsedRange.Clear
Next

Related

Unable to delete sheets that meet a condition

I keep getting
runtime error 1004 - Application defined or object defined error
for the code below. Could you help me figure out why this is happening?
Option Explicit
Sub DeleteSheet()
Dim Sh As Worksheet
Application.DisplayAlerts = False
For Each Sh In ThisWorkbook.Worksheets
If Application.WorksheetFunction.Search("Generation", Sh.Range("A1").Value, 1) = 1 Then
Sh.Delete
End If
Next Sh
Application.DisplayAlerts = True
End Sub
You can't delete a sheet which is also a control variable in a loop. Use a counter instead to iterate through the sheets, then delete using the counter, eg
dim sheetCount
dim i
sheetCount = ThisWorkbook.Worksheets.Count
for i = sheetCount to 1 step -1
dim sh as Worksheet
set sh = ThisWorkbook.Worksheets(i)
If Application.WorksheetFunction.Search("Generation", sh.Range("A1").Value, 1) = 1 Then
ThisWorkbook.Worksheets(i).Delete
End If
next i
Delete Worksheets Using an Array of Worksheet Names
I couldn't reproduce the exact error.
The covered scenarios producing errors were the following:
when generation was not found in cell A1,
the last sheet cannot be deleted,
when a sheet was very hidden.
VBA has its own FIND or SEARCH equivalent called Instr.
In the workbook containing this code (ThisWorkbook), it will delete all worksheets whose cell A1 contains a string starting with Generation.
Option Explicit
Sub DeleteSheets()
Dim wsCount As Long: wsCount = ThisWorkbook.Worksheets.Count
Dim wsNames() As String: ReDim wsNames(1 To wsCount) ' Worksheet Names Array
Dim ws As Worksheet
Dim n As Long
For Each ws In ThisWorkbook.Worksheets
' Check if 'A1' contains a string starting with 'Generation'.
If InStr(1, CStr(ws.Range("A1").Value), "Generation", _
vbTextCompare) = 1 Then
n = n + 1 ' next array element
wsNames(n) = ws.Name ' write the worksheet name to the array
End If
Next ws
' Check if no worksheet name was added to the array.
If n = 0 Then Exit Sub
' Resize the array to the number of found worksheets.
If n < wsCount Then ReDim Preserve wsNames(1 To n)
' Delete the worksheets, without confirmation, in one go.
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(wsNames).Delete
Application.DisplayAlerts = True
End Sub

How to use information from a ComboBox in another one?

I'm trying to make a UserForm with comboboxes and textboxes. I have two combobox that are working together. In the first one you choose the right sheet and in the second you choose the right column in the selected sheet.
My problem is that even though my code is working, the second combobox doesn't use the moving information from the first one. It always displays the columns from the first sheet whatever my choice. So how do I get the data from the first one to use it in the second one?
Here's my code:
Private Sub UserForm_Initialize()
Dim I As Long
Me.ComboBox1.Clear
For I = 7 To Sheets.Count
Me.ComboBox1.AddItem Sheets(I).Name
Next
Me.ComboBox1.Value = ActiveSheet.Name
Me.ComboBox2.Clear
Dim j As Integer
Dim puits As String
j = 3
Do While Worksheets(ComboBox1.Text).Cells(1, j).Value <> ""
Me.ComboBox2.AddItem Worksheets(Me.ComboBox1.Text).Cells(1, j).Value
j = j + 3
Loop
End Sub```
EDIT
[USF is to automate the change of the selected cell in this screenshort, same tables on different sheets][1]
[1]: https://i.stack.imgur.com/7bbQG.png
You need to use the Combobox_Change-Event. This Example shows what I mean:
Private Sub ComboBox1_Change()
Dim ws As Worksheet
Dim lCol As Long, i As Long
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
UserForm1.ComboBox2.AddItem ws.Cells(1, i).Value
Next
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Me.ComboBox2.Clear
Dim ws As Worksheet
Dim i As Long
i = 1
For Each ws In ThisWorkbook.Worksheets
Me.ComboBox1.AddItem ws.Name
i = i + 1
Next ws
End Sub
When I select the Sheet, I change the first Combobox, which triggers the Change-Event. And I then populate the second Combobox according to the selected sheet.
EDIT
You could insert a CommandButton and use code like the following:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
Set rng = ws.Range(UserForm1.ComboBox2.Value)
rng.Value = "Your Date"
End Sub

VBA - Get the name of all ActiveSheets

The following code returns the name of all the worksheets from the workbook. What I would like it to do is to return only the name of my active sheets.
I have multiple Sheets selected
What do I need to change to correct it? I suppose it's in that "For each" section
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim x As Integer
x = 0
Dim aSheetnames As Variant
aSheetnames = Array("")
For Each ws In Worksheets
'Redimensiona array
ReDim Preserve aSheetnames(x)
aSheetnames(x) = ws.Name
x = x + 1
Next ws
Dim str As String
For j = LBound(aSheetnames) To UBound(aSheetnames)
str = str & aSheetnames(j) & Chr(13)
Next j
MsgBox str
End Sub
You can use the following code snippet to get all selected sheets.
ActiveWorkbook.Windows(1).SelectedSheets
Description: SelectedSheets
Otherwise you can also get the name of the activated sheet with
ThisWorkbook.ActiveSheet.Name
Description: ActiveSheet
In your case you have to change the For loop as follows:
For Each ws In ActiveWorkbook.Windows(1).SelectedSheets
ReDim Preserve aSheetnames(x)
aSheetnames(x) = ws.Name
x = x + 1
Next ws

Copy specific sheet names from range

I need help and I'm hoping someone here can help me :)
I have a workbook that runs some reports from Avaya CMS. It runs the report and creates a new sheet for each persons name on the MAIN sheet. << This part works wonderfully.
My issue is I cannot figure out how to use that range of names on the MAIN sheet to select only those specific sheets and then copy them to a new workbook.. There's 2 other hidden sheets as well.. Which is why I think using the range of names is easier but I'm open to anything at this point.
Here's an screeshot of what it looks like :
Sorry, I couldn't figure out how to upload the workbook here but the image should, hopefully, be good enough. Thank you for your time and help!
Here's an image with the hidden sheets.
I need it to exclude the first 3 sheets/
And here's the code:
Sub Macro1()
Dim sheetArray() As String
Dim i As Integer
i = 0
For Each c In MainSheet.Range("A2:A20").Cells
ReDim Preserve sheetArray(0 To i)
sheetArray(i) = c.Value
i = i + 1
Next
Sheets(sheetArray).Select
End Sub
Sub move_Sheets()
Dim mSH As Worksheet
Set mSH = ThisWorkbook.Sheets("Main")
Dim shArray() As String
Dim i As Integer
i = mSH.Range("A" & Rows.Count).End(xlUp).Row
ReDim Preserve shArray(0 To i - 2)
For a = 2 To i
shArray(a - 2) = mSH.Range("A" & a).Value
Next a
ThisWorkbook.Sheets(shArray).Move
End Sub
You could try:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, sheetIndex As Long
Dim SheetName As String
Dim ws As Worksheet
With ThisWorkbook.Worksheets("Main")
'Last row of column where the names appears
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop the column from row 2 to last row
For i = 2 To LastRow
'Set Sheet name
SheetName = .Range("A" & i).Value
'Check if the sheet with the SheetName exists
If DoesSheetExists(SheetName) Then
'Insert the code to code
sheetIndex = Workbooks("Book2").Sheets.Count
ThisWorkbook.Worksheets(SheetName).Copy After:=Workbooks("Book2").Sheets(sheetIndex)
Else
End If
Next i
End With
End Sub
Function DoesSheetExists(SheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(SheetName)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExists = True
End Function

Remove obsolete values from table that is populated with a For Each loop?

The current code loops through each worksheet that begins with "Rev" and returns a specific cell value, which populates a table on my worksheet "Table".
This works fine. However, if a Rev worksheet is removed, the value in the Table worksheet remains.
With that background info, what is a solution to only keep current Rev worksheet values from populating the table?
Sub Rev_loop()
Dim ws As Worksheet
Dim n As Long
For Each ws In Worksheets
If ws.Name Like "Rev*" Then
n = n + 1
Worksheets("Table").Cells(n).Value = ws.Range("B2").Value
End If
Next ws
End Sub
Clear the table first. Then iterate through the Worksheets as before.
Something like this:
Worksheets("Table").Range("B2:B99").ClearContents
If you don't want to clear the table before your next loop, you have to remember the sheet's names somewhere.
By this example you can store the sheet's names and their value together in the first two columns:
Sub Rev_loop()
Dim ws As Worksheet
Dim n As Long
With Worksheets("Table")
n = 0
For Each ws In Worksheets
If ws.Name Like "Rev*" Then
n = n + 1
.Cells(n, 1).Value = ws.Name
.Cells(n, 2).Value = ws.Range("B2").Value
End If
Next ws
End With
End Sub
By this second loop, you compare the stored sheet's names and delete all rows with outdated names:
Sub Correct_loop()
Dim ws As Worksheet
Dim StillValid As Boolean
Dim n As Long
With Worksheets("Table")
For n = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
StillValid = False
For Each ws In Worksheets
If ws.Name = .Cells(n, 1).Value Then
StillValid = True
Exit For
End If
Next ws
If Not StillValid Then .Rows(n).Delete
Next n
End With
End Sub

Resources