Selecting multiple sheets using a range - vba

I have sheet names in cells C2 to C5, which are dynamic. I would like to select them at the same time using VBA.
The only way I have found uses arrays and "hard-coding" the sheet names.
Sub ssheets()
Worksheets(Array("Sheet2", "Sheet3","Sheet4","Sheet5")).Select
End Sub
I would like something that uses Range("C2:C5") so that I can select the relevant sheets without having to type in "Sheet2", "Sheet3","Sheet4","Sheet5" etc.

The sheet names array has to be of type Variant containing a one dimensional array. The Range("C2:C5") returns a two dimensional array. To use this as sheet names array, you have to transpose it.
Sub ssheets()
Dim oWS As Worksheet
Dim aSheetnames As Variant
Set oWS = Worksheets(1)
aSheetnames = oWS.Range("C2:C5")
aSheetnames = Application.WorksheetFunction.Transpose(aSheetnames)
Worksheets(aSheetnames).Select
End Sub

Try this:
Sub Macro1()
Dim sheetArray() As String
Dim i As Integer
i = 0
For Each c In Range("C2:C5").Cells
ReDim Preserve sheetArray(0 To i)
sheetArray(i) = c.Value
i = i + 1
Next
Sheets(sheetArray).Select
End Sub
You may also consider adding verification if the sheet with that name exists before adding it to array.

3 lines of code needed (2, if you want ActiveSheet selected as well):
Sub sSheets()
Set xRange = Range("C2:C5") 'define ur range
Sheets(xRange.Cells(1).Value).Select 'this is only needed to de-select the ActiveSheet
For Each xCell In xRange: Sheets(xCell.Value).Select False: Next '[False] is like holding Ctrl and clicking on different tabs
End Sub

Related

Pasting into last column of table

I've been creating a VBA code to help me with a worksheet I use but I'm stuck at a certain point.
The code looks at the table on the current worksheet, adds a new column to the end of the table and then I get it to copy the first column in the worksheet (as this has the formats and some calculated cells). This is where my coding finishes. Ideally I would then like it to take the copied cells and paste them into the new end column of the table.
This is what I have so far:
Sub AddNewColumn()
Application.ScreenUpdating = False
Dim oSh As Worksheet
Set oSh = ActiveSheet
With oSh.ListObjects("Labour")
.ListColumns.Add
Range("Labour[[#All],[Column16]]").Select
Selection.Copy
End With
Application.ScreenUpdating = True
End Sub
(Labour being the name of the current table).
If I can get this to work fantastic but then I think I will encounter another issue. The table is on a template worksheet and contained on this I have a command button to create a copy of the template (for different tasks). This would then change the name of the table (Labour1 then Labour2 etc as new worksheets are created). How would I get the code to work on new worksheets as the code I have at the minute would simply want to link back to the original table (Labour).
You don't need actually copy values from the first column to the newly created, just use formula. I have modified your code:
Sub AddNewColumn()
Application.ScreenUpdating = False
Dim oSh As Worksheet
Dim oList As ListObject
Dim str As String
Set oSh = ActiveSheet
Set oList = oSh.ListObjects("Labour")
With oList
.ListColumns.Add
str = .ListColumns(1).Name
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=[#[" & str & "]]"
End With
End Sub
If you need actual values, not formulas, you may copy and paste special the last column. Before end with add:
With .ListColumns(.ListColumns.Count).DataBodyRange
.Copy
.PasteSpecial xlPasteValues
End With
This is answer to your first question. Unfortunately, I am not able to understand the second. Besides, I think you should ask it separately.
OK I have tweaked your code #MarcinSzaleniec and it appears to be working.
Sub AddNewColumn()
Application.ScreenUpdating = False
Dim oSh As Worksheet
Dim oList As ListObject
Dim str As String
Set oSh = ActiveSheet
Set oList = oSh.ListObjects("Labour")
With oList
.ListColumns.Add
str = .ListColumns(1).Name
Range("Labour[[#All],[Column16]]").Select
Selection.Copy
.ListColumns(.ListColumns.Count).DataBodyRange.PasteSpecial xlPasteAll
Application.ScreenUpdating = True
End With
End Sub
The reason I need:
Range("Labour[[#All],[Column16]]").Select
Selection.Copy
Is due to it being a column hidden out the way and has the blank bits blank and the formula bits as formulas.
Many thanks for everybody's help. Now to ask the second part of my question on here.

How to generate new sheet from find result?

I would like to generate new sheet for all values contains "_S" :
Example:
When user click on "Generate page", two new sheet are created (one sheet with title "Folder22_S" and other one with title "Folder3_S"
In second time, i would like that new sheet generated from a model (not generate a empty sheet)
My question is: How to do this ? I doesn't know how to find all values contains "_S" and get cell value ( Folder22_S and Folder3_S) ?
My pseudo VBA code:
Sub generate()
'Array contains all values *_S'
Dim AllValuesContains_S As Variant
AllValuesContains_S = Array("Folder22_S", "Folder3_S", ...)
For Each item As String In AllValuesContains_S
Sheets.Add.Name = item
Next
End Sub
I will assume the range you want to search is A2:C7. Adjust that portion of the code to be whatever range you need.
Sub New_Wksht()
Dim SearchRange as Range, c as Range
Dim sht as Worksheet
With ThiwWorkbook
Set SearchRange = .Sheets("Your Sheet Name").Range("A2:C7") 'Change sheet name and range to be what you need
For Each c in SearchRange
If Right(c.Value,2) = "_S" Then
Set sht = .Sheets.Add
sht.Name = c.Value
End If
Next C
End With
End Sub

Excel VBA - Add new table columns with specific header names

I have a simple vba question. I want a macro that will add exactly 4 new columns in my table object, ("Table1"). I would also like these to be named in order, from left to right:
AHT, Target AHT, Transfers, Target Transfers
The code I have below adds the columns just fine, but I am not sure how to name one individually. Also, could someone please show me how to loop that section of code. Thanks!
Sub insertTableColumn()
Dim lst As ListObject
Dim currentSht As Worksheet
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
'below is the code that I would like to have looped
lst.ListColumns.Add
lst.ListColumns.Add
lst.ListColumns.Add
lst.ListColumns.Add
End Sub
A variant array is a good place to store the variables in a looped sequence.
Sub insertTableColumn()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim h As Long, hdrs As Variant
hdrs = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
With lst 'ActiveSheet.ListObjects("Table1")
For h = 0 To 3
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = hdrs(h)
Next h
End With
End Sub
When creating an array of strings in this manner, remember that the variant array's index is zero-based by default.
The following code creates an array of the column names you want to add, then loops as many times as there are headers to add and sets the name at the same time.
Sub insertTableColumn()
Dim lst As ListObject
Dim currentSht As Worksheet
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
ColumnNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
' below is the code that I would like to have looped
For iLoop = 0 to UBound(ColumnNames)
Set oLC = lst.ListColumns.Add
oLC.Name = ColumnNames(iLoop)
Next
End Sub

VBA: VLookup between two workbooks

I am wondering if someone can help me out. I created a Userform with 3 comboboxes. Combobox 1 and 2 list all open workbooks. Combobox 3 lists the worksheets from Combobox 2. I now want to run a Vlookup. The lookup values are the values (in this case product codes) in each cell beginning at D9 to the last cell with a value in Column D of the first Worksheet of Combobox2's. The lookup range will be ("A5:S###"[number of rows varies depending on the file]").
The Vlookup formula should be in the Column I of the first Worksheet of Combobox2's value starting at "I9" looping through each cell in I9 until all the Codes in D9 are looked up.
I keep getting error the major one being “Runtime-error '9'”: Subscript out of range. Here is my code.
Option Explicit
Private Sub CancelButton_Click()
Stopped = True
Unload Me
End Sub
Private Sub ComboBox1_Change()
Dim ScheduleA As Workbook
Dim Termset As Worksheet
Set ScheduleA = Workbooks(Me.ComboBox1.Value)
With Me.ComboBox3
For Each Termset In ScheduleA.Worksheets
.AddItem Termset.Name
Next Termset
End With
End Sub
Private Sub FillACDButton_Click()
Dim ACDRebateInfo As Worksheet
Dim lastRow As Long
Dim NewRebate As Single
Dim NewRebateType As String
Dim LookUp_Range As Range
Dim ActionCode As String
Dim ACD_NewRebate As Range
Dim ACD_NewRebateType As Range
Dim ACD_ActionCode As Range
Dim SCC As Range
Dim Cell As Range
Set ACDRebateInfo = Workbooks(Me.ComboBox2.Value).Worksheets(1)
Set ACD_NewRebate = ACDRebateInfo.Range("I9:I500")
Set ACD_NewRebateType = ACDRebateInfo.Range("J9:J500")
Set ACD_ActionCode = ACDRebateInfo.Range("B9:B500")
Set LookUp_Range = Worksheets(Me.ComboBox3.Value).Range("A5:S400")
Set SCC = ACDRebateInfo.Range("D9:D230")
With ACDRebateInfo
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
End With
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wkb As Workbook
For Each wkb In Application.Workbooks
Me.ComboBox1.AddItem wkb.Name
Me.ComboBox2.AddItem wkb.Name
Next wkb
End Sub
Not sure this is your issue but this piece of code does not make sense:
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
You are looping through the Action Codes but not using the Cell variable

VBA return sum of range values from different workbook

I am trying to use VBA in an excel sheet (lets call it wbA) to find the sum of the values in a range of cells in another workbook (lets call that wbB). I have tried using a custom made summing function
Function sumrange(rng As Range)
summ = 0
For Each cell In rng
summ = summ + cell.Value
Next
sumrange = summ
End Function
which i execute in the wbA here
Sub test4()
Dim app As New Excel.Application
Dim book As Excel.Workbook
Set book = app.Workbooks.Add("...\wbB.xlsm")
With book.Worksheets("November2013")
a = sumrange(Range("B5:T9"))
End With
MsgBox a
End Sub
This returns the sum of the set range in wbA instead of wbB
i have also tried the worksheetfunction.sum option in the following formats
l = book.Worksheets("November2013").Application.WorksheetFunction.Sum(Range(B5:T9"))
and
With book.Worksheets("December2014")
p = Application.WorksheetFunction.Sum(Range(B5:T9"))
End With
but both caluclate and return the sum of the range from wbA instead of from wbB
How do i write the code to find sum of range in wbB
Thanks
For those who are still looking for a one-line-solution:
Cells(10, 1) = WorksheetFunction.Sum(Worksheets("data").Range(Worksheets("data").Cells(3, 35), Worksheets("data").Cells(131, 35)))
Just took it from my code, it addresses the range by cells, but you can easily use RANGE("...") instead of the CELLS(,) function).
The example line above writes the sum of worksheet "data" (range("AI3:AI131")) to A10 of current worksheet.
Your code works for me with the change that I mentioned. This is what I tried
When you specify a range without fully qualifying it, it will always refer to active sheet. And ActiveSheet might not be the sheet that you expect it to be and hence fully qualify your objects.
Sub test4()
Dim book As Workbook
Dim a
Set book = Workbooks.Open("C:\Book1.xlsx")
a = sumrange(book.Worksheets(1).Range("A1:A4"))
MsgBox a
End Sub
Function sumrange(rng As Range)
summ = 0
For Each cell In rng
summ = summ + cell.Value
Next
sumrange = summ
End Function
I notice that you are using
Set book = app.Workbooks.Add("...\wbB.xlsm")
Use .Open Like I have done.
EDIT:
#SiddharthRout yes i am running it from the VBA window in excel – user3041384 3 mins ago
In such a case, you don't need to define your excel application. Your code can be re-written as
Sub test4()
Dim book As Workbook, a
Set book = Workbooks.Open("...\wbB.xlsm")
With book.Worksheets("November2013")
a = sumrange(.Range("B5:T9"))
End With
MsgBox a
End Sub