Add multiple sheets, name them, and copy paste dynamic range into new sheets - vba

I'm new to excel and I'm trying to add multiple sheets, name each one. The macro is only adding one sheet at a time, example I will click "run" and it will create the "Price Adjustment" table but no others. When I click "run" again it will create the following table only, and so on.
Sub NewSheets()
With Sheets.Add()
.Name = "CustomerTable"
.Name = "EmployeeTable"
.Name = "OrdersTable"
.Name = "ProductTable"
.Name = "PriceAdjustment"
End With
End Sub
Thanks

The quickest improvement of the code is to move Add() method inside With...End With statement like this:
Sub NewSheets()
With Sheets
.Add().Name = "CustomerTable"
.Add().Name = "EmployeeTable"
.Add().Name = "OrdersTable"
.Add().Name = "ProductTable"
.Add().Name = "PriceAdjustment"
End With
End Sub

Another way to go about this is to put the new sheet names into an array and then loop through the array to create all five of your tables at once.
Couple of things to note about the code:
The array shArray for the sheet names is declared as a Variant so that we can populate the array with the Array function without having to loop through the array to assign each element.
In setting up the For loop, I use the LBound and UBound functions to calculate the index numbers for the first and last elements of the array. That way, it's not necessary to keep track of the number of array elements if the number changes.
Option Explicit 'Turn on compiler option requiring
'that all variables be declared
Sub NewSheets()
Dim shArray() As Variant 'Declare the sheet Name array and a
Dim i As Long 'counter variable
shArray = Array("CustomerTable", _
"EmployeeTable", _
"OrdersTable", _
"ProductTable", _
"PriceAdjustment") 'Populate the array
For i = LBound(shArray) To UBound(shArray) 'Loop through the elements
Sheets.Add().Name = shArray(i)
Next i
End Sub

This is because you are calling the Add() method once. Try this:
Sub AddNewWorksheet(name as String)
With Worksheets.Add()
.Name = name
End With
End Sub
Then you can add worksheets just like this:
AddNewWorksheet("CustomerTable")
AddNewWorksheet("EmployeeTable")
'...

Related

Selecting only sheets matching name

I'm working on a macro which will run through the files in the folder and then copy sheets from all excel files to the workbook from which the macro was run.
This part works as charm, what I want to do is to select and copy sheets that match exact name.
For Each wksCurSheet In wbkSrcBook.Sheets
'I reckon I should add some if statement in here
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
Honestly, I have no idea how to write that statement, examples I found were quite confusing and when I try something by myself, I get weird errors.
If (wksCurSheet.Name == "AO-SC") Then
If (wksCurSheet.Name as String == "AO-SC") Then
If (wksCurSheet.("AO-SC")) Then
What's the correct way?
This is the way to get the specific worksheet through loop:
For Each wksCurSheet In wbkSrcBook.Worksheets
If wksCurSheet.Name = "AO-SC" Then
'Do something
End If
Next
This is how to use it with two worksheets:
If wksCurSheet.Name = "AO-SC" Or wksCurSheet.Name = "SomethingElse" Then
And if the worksheets, you are interestd in are saved in an array, you can use a custom function valueInArray, checking whether the worksheet's name is part of the predefined array:
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If CStr(myValue) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
This is how to use it:
predefinedArrayWithNames = Array("Sheet1", "Sheet2","Sheet3")
If valueInArray(wksCurSheet.Name, predefinedArrayWithNames) Then

Searching and Returning bold values in VBA

I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub

VBA Excel - ways to store lists in VBA?

I didn't know where else to turn, and I tried finding a question like mine but with no luck. I have a raw ranged table and I want to copy the info over into a new sheet, then convert that copied info into a ListObject table. I've worked out 99% of it, but then I wanted to change the raw headers of the copied table into my own headers (because most of the raw headers are very lengthy).
I built a loop to look at the [#Headers] cells, find values that matched a certain raw value, then replace it with my own value. E.g.
For Each cl In Range("Table1[#Headers]")
If cl.Value = "Employee" Then
cl.Value = "Name"
ElseIf cl = "Employer Name" Then
cl.Value = "Company"
'...
End If
Next cl
Having a block of code that does this for 30+ instances is cumbersome, and if the raw information I receive somehow changes it's header values, I then have to hunt for this bit of code again and make the changes. I'm hoping there's a way to store a 2-columned list of before-and-after header names that any Sub can just reference, like a global Array (except global arrays are impossible). I looked into classes but again there are issues I'm having with globalizing the info.
I'm thinking about making a hidden worksheet with a 2-columned list but I'm really hoping that's not necessary, don't want any more sheets than I have to have. Is there a way to store lists for global use in Excel VBA?
Example image
SOLUTION:
Using #Mat's Mug advice, I'll show how I figured out how I added my Dictionary.
I made a public variant called DHeader and created a Sub to Call from:
Public DHeader As Dictionary
Sub Load_Headers()
If Not DHeader Is Nothing Then Exit Sub
Set DHeader = New Dictionary
With DHeader
.add "Employee", "Name"
.add "Employer Name", "Company"
'...
End With
End Sub
Then within my action Sub I added this:
Call Load_Headers
For Each i_1 In Range("Table1[#Headers]")
If DHeader.Exists(CStr(i_1.Value)) = True Then
i_1.Value = DHeader.Item(CStr(i_1.Value))
End If
Next i_1
Now my values and actions are separated into different parts of my code. I think I have to add a way to clear the dictionary in my action sub still, but it works!
No matter what you do, you're going to need to have the mappping code somewhere.
If a huge If-Then-Else block isn't very appealing, you can consider using a Dictionary object, from the Scripting library - using the "before" column name as your dictionary key, and the "after" column name as your dictionary value, the mapping code could look something like this:
Dim ColumnMap As New Scripting.Dictionary
With ColumnMap
.Add "Employee", "Name"
.Add "Employer Name", "Company"
'...
End With
Then when you iterate the cells in the header row, you can verify that the name/key exists in your dictionary, and then proceed with the rename by fetching the mapped value. Just don't assume the column name exists in the dictionary, or you'll eventually run into "Key does not exist" runtime errors.
An alternative to dictionaries (although that might be be my preferred method, I would initialize them in a separate procedure) would be to split strings:
Sub DoStuff()
Const RawList As String = "Employee,Employer Name"
Const UpdateList as String = "Name,Employer"
Dim rawHeaders as Variant
Dim headers as Variant
rawHeaders = Split(RawList, ",")
headers = Split(UpdateList, ",")
For Each cl In Range("Table1[#Headers]")
If Not IsError(Application.Match(cl.Value, rawHeaders, False)) Then
cl.Value = headers(Application.Match(cl.Value, rawHeaders, False))
End If
Next
End Sub
You can scope the arrays at the module level instead so they will be available for other procedure calls, etc.
Why not use the simple VBA Collection? No extra reference needed, no late binding needed, it is build directly into VBA.
Note: if the item is not found in the map, then the original raw header value is not replaced but it is simply skipped.
Option Explicit
Public Sub Main()
Dim header As Range
Set header = Worksheets("RawData").ListObjects("Table1").HeaderRowRange
ReplaceInheaderRow headerRow:=header
' header contains transformed values now
End Sub
Private Function ReplaceInheaderRow(ByVal headerRow As Range) As Range
Dim map As Collection
Set map = New Collection
map.Add "Name", "Employee"
map.Add "Company", "Employer Name"
map.Add "ID", "ID Numbers"
map.Add "Income", "Wages"
map.Add "etc.", "Some next column name"
On Error Resume Next
Dim rowHeaderCell As Range
For Each rowHeaderCell In headerRow
rowHeaderCell.Value = map(rowHeaderCell.Value)
Next rowHeaderCell
On Error GoTo 0
End Function

Passing Cell Values into a combo box list

I am looking to pass cells values into the list for a combo box in Excel.
I have created an array to pass the cell values into but they aren't getting to the combo box list when they are being called. I need the cell values to display as the drop down items and all that displays is the blank space:
Sub Clear_Invoice_Data()
Dim Arr As Variant
Arr = Range("A1:A5").Value
frmAddLineItem.ddlProduct.List = Arr
End Sub
It is called by a button from a User form:
Private Sub cmdClearAll_Click()
Call Button_Functions.Clear_Invoice_Data
i = 18
End Sub
Pictures of problem: (no values)
There is another (rougher) method found here to do this if you so choose. Also make sure you define the Sheet name you are sourcing the data from:
Sub AddItemsToBox()
Dim itemcell As Range
For Each itemcell in Sheets("Source Sheet Name").Range("A1:A5")
frmAddLineItem.ddlProduct.AddItem itemcell.Value
Next itemcell
End Sub
Using ComboBox, you can use .List property of the same to populate worksheet values to combox box.
Check this below example:
ComboBox1.List = Worksheets("Sheet1").Range("A1:A5").Value
If you want to use Array,
Dim Arr As Variant
Arr = Worksheets("Sheet1").Range("A1:A5").Value
ComboBox1.List = Arr
I am just getting into VBA and I am doing exactly this. I think the way I found is pretty easy and straightforward. I'll share it in case it can help someone
Declare variable to store table from Worksheet as "range". Make sure
it's outside of sub routines so it can be called by any function
Dim myTable As Range
Store table values in declared variable. Then select which column (range) of values you want to store in your combo box.
Private Sub UserForm_Initialize()
Set myTable = Worksheets("dataSheetName").Range("A2:B6")
Me.myComboBox.List = myTable.Columns(1).Value
End Sub ```

How to collect data from multiple sheets by using sheet names

Thanks for the response!
however the code which you sent started from the beginning of the workbook. but it should not be.
For example, a workbook contains sheets (only user knows the sheet name, so we can't give the sheet name on the code) as following
Summary/Version/AA/BB/CC/DD/Final
If beginsheet=AA then the code should start collecting data from AA and if endsheet = DD then the code should stop collecting data at Final. Only till DD is valid.
So how can we achieve this.
You can do a FOR - EACH: For each theSheets in ActiveWorkbook.Sheets
For each theSheets in ActiveWorkbook.Sheets
Sheets(theSheets.Name).Select
msgbox(theSheets.Name)
next
I put the MSGBOX just to show the name of the sheet. Also the Select is not necessary I put it there just to show how it changes from sheet to sheet.
If you don't want to search all sheets (each sheet) but a specified number of sheets, you can assign the sheets names to a collection and the iterate that collection; in that case you have to know the names of the sheets.
sorry I did not get your first question...
Well, I don't know how practical this solution will be for you purpose but you could do the following:
When you open the workbook create CheckBoxes with the names of the Sheets:
Private Sub Workbook_Open()
Dim row As Integer
row = 14
For Each mysheets In ActiveWorkbook.Sheets
ActiveSheet.CheckBoxes.Add(20, row, 50, 20).Select
With Selection
.Caption = mysheets.Name
.Value = xlOff
.LinkedCell = "C" & ToRow
.Display3DShading = False
End With
row = row + 50
Next
End Sub
Have the users select the Sheets that apply.
Fill a collection with the "Text" of the selected CheckBoxes (which will be the names of the sheets)
Iterate through the sheets in the collection
Dim allSelectedSheets As New Collection
Public Sub FindSelectedCkBox()
For Each ckbox In ActiveSheet.CheckBoxes
If ckbox.Value > 0 Then
allSelectedSheets.Add ckbox.Text
End If
Next
iterateThroughSheets
End Sub
Sub iterateThroughSheets()
For Each theSheets In allSelectedSheets
ActiveWorkbook.Sheets(theSheets).Select
Next
End Sub
Make sure to remove the CheckBoxes when opening the Book so you don't end up with duplicates.