Take data from all books to some table - excel

I am very new in EXCEL (especially in VBA). I try to write logic that:
go to all open books, if some book has sheet with name "Test", it should take data from named range "Table" and then append it to the Table1 from sheet ALLDATA in book ALLDATABOOK. I try to write this, can someone help me?
Here is my code:
Private Sub CommandButton1_Click()
Dim book As Object
Dim lst As ListObject
Dim iList As Worksheet
For Each book In Workbooks
For Each iList In book.Sheets
If iList.Name = "Test" Then
book.Sheets(iList.Name).Activate
Range("Table").Select
End If
Next
Next
End Sub

Try this (written for Excel 2007+, may not work for earlier versions)
Private Sub CommandButton1_Click()
Dim book As Workbook
Dim lst As ListObject
Dim iList As Worksheet
Dim Rng As Range
Dim wbAllDataBook As Workbook
Dim shAllData As Worksheet
' Get reference to ALLDATA table
Set wbAllDataBook = Workbooks("ALLDATABOOK.xlsm") '<-- change to suit your file extension
Set shAllData = wbAllDataBook.Worksheets("ALLDATA")
Set lst = shAllData.ListObjects("Table1")
For Each book In Workbooks
' Use error handler to avoid looping through all worksheets
On Error Resume Next
Set iList = book.Worksheets("Test")
If Err.Number <> 0 Then
' sheet not present in book
Err.Clear
On Error GoTo 0
Else
' If no error, iList references sheet "Test"
On Error GoTo 0
' Get Reference to named range
Set Rng = iList.[Table]
' Add data to row below existing data in table. Table will auto extend
If lst.DataBodyRange Is Nothing Then
' Table is empty
lst.InsertRowRange.Resize(Rng.Rows.Count).Value = Rng.Value
Else
With lst.DataBodyRange
.Rows(.Rows.Count).Offset(1, 0).Resize(Rng.Rows.Count).Value = Rng.Value
End With
End If
End If
Next
End Sub
Update:
To use with Excel 2003 replace
If lst.DataBodyRange Is Nothing Then
with
If Not lst.InsertRowRange Is Nothing Then

Related

Copy all conditional formatting rules from one sheet to another

When I set up a new project I have a template sheet that I copy a specific range from. This pulls in the headers for a number of tables and their functions. However, the tables are scalable both across rows and down columns so I have a number of conditional formatting rules to ensure the data is presented in the right way as it scales.
The code I use to copy the sheet is as follows and I have it adjusting the widths of the columns automatically to ensure all the data is visible -
Sub CreateNewSheet(strNameOfSheetToCreate As String, strNameOfSheetToCreateAfter As String, strDefaultSheetToCreateAfter As String)
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim strCreateAfterSheetName As String
If Not IsTextEmpty(strNameOfSheetToCreateAfter) Then
strCreateAfterSheetName = strNameOfSheetToCreateAfter
Else
If Not IsTextEmpty(strDefaultSheetToCreateAfter) Then
strCreateAfterSheetName = strDefaultSheetToCreateAfter
End If
End If
' Only create sheet if sheet doesn't exist
If Not IsTextEmpty(strCreateAfterSheetName) Then
' Only create sheet if sheet doesn't exist
If Not WorkSheetExists(strNameOfSheetToCreate, wb) Then
If WorkSheetExists(strCreateAfterSheetName, wb) Then
wb.Sheets.Add(After:=wb.Sheets(strCreateAfterSheetName)).Name = strNameOfSheetToCreate
Else
wb.Sheets.Add.Name = strNameOfSheetToCreate
End If
' Update the list of sheets
ListSheets
End If
' Copy all cells including functions for specified range
wb.Worksheets("Project 1").Range("A1:I15").Copy wb.Worksheets(strNameOfSheetToCreate).Range("A1:I15")
' Fix Sheet Column widths to match the data
Dim SheetToModify As Worksheet
Set SheetToModify = wb.Worksheets(strNameOfSheetToCreate)
AutofitAllUsedColumns SheetToModify
End If
End Sub
Function WorkSheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorkSheetExists = Not sht Is Nothing
End Function
Sub AutofitAllUsedColumns(ByVal mySheet As Worksheet)
mySheet.UsedRange.EntireColumn.AutoFit
End Sub
' Check if string is empty
Public Function IsTextEmpty(t As String)
If Trim(t & vbNullString) = "" Then
End If
End Function
The following are all the rules I'd like to copy to the new sheet. Any help to automate this on creating the new project sheet will be appreciated.

Trying to use ComboBox to use supplier name and populate form in other sheet

on one sheet I have a list of suppliers and their details, I have a userfrom containing a combobox that automatically populates from the list of suppliers. In the columns next to the suppliers, I have details with address, phone number etc. What I am attempting to do is after the user makes the selection, I would like the code to take the details in the adjacent columns and fill in the form. I have tried using the lookup function however I am constantly being given an error stating that the object could not be found. Below is what I have so far
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Worksheets("RFQ Information")
'Take supplier name from combobox
'Copy row data in supplier sheet and paste (transposed) into form
Dim xRg As Range
Set xRg = Worksheets("Suppliers").Range("A2:H15")
Set Cells(53, 1) = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, xRg, 2, False)
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim SupplierName As Range
Dim SupSheet As Worksheet
Dim tbl As ListObject
Dim SupArray As Variant
Dim SupString As String
Set SupSheet = Sheets("Suppliers")
Set tbl = SupSheet.ListObjects("Table1")
Set SupplierName = tbl.ListColumns(1).DataBodyRange
SupArray = SupplierName.Value
ComboBox1.List = SupArray
UserForm1.Show
MsgBox ("done")
End Sub
I would recommend using the ComboBox Change event instead of a button, since you want the info on list selection. You can also take advantage of the ComboBox.ListIndex property to get the selected item's location in the list, and then use that to get adjacent values from your data table. Here's a quick example of how to do so:
Private Sub ComboBox1_Change()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSup As Worksheet: Set wsSup = wb.Worksheets("Suppliers")
Dim rData As Range: Set rData = wsSup.ListObjects("Table1").DataBodyRange
Dim i As Long: i = Me.ComboBox1.ListIndex + 1
If i = 0 Then Exit Sub 'Nothing selected
'Second number is the column
' Column 1 is the Supplier
' Column 2 is the next column (phone maybe?)
' Column 3 is the column after that (address maybe?)
MsgBox rData.Cells(i, 2) & Chr(10) & _
rData.Cells(i, 3)
'Load the values you want into the necessary form controls
End Sub

Why am I getting a Subscript Out of Range Error 9 when referencing another Workbook/Worksheet in VBA?

I have a Macro (within a Master Workbook) that is getting data from another Workbook/Worksheet using .value2.
I've tried different changes, within the code. I double checked that both workbooks are open. However, I keep getting the Subscript out of range (Error 9).
Sub NielsenScorecard_DataPaste()
Dim WbNielsenScorecard As Workbook
Set WbNielsenScorecard = Workbooks("Nielsen Scorecard_Template.xlsm")
TotalUS_DataPaste
End Sub
Sub TotalUS_DataPaste()
**Subscript out of range (Error 9)**
With Workbooks("Power Query - Meijer_Walmart_Total US xAOC.xlsm").Worksheets("PQTotalUS")
Dim Data(0) As Variant
'Copy Data Range
Data(0) = .Range(.Cells(.Rows.Count, "A").End(xlUp), "AA2").Value2
End With
'Worksheet Code Name within this Workbook
With wsTotalUS
Debug.Print wsTotalUS.Name
.AutoFilter.ShowAllData
.Range("A2:AA" & .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row).ClearContents
With .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(Data(0)))
.Resize(ColumnSize:=UBound(Data(0), 2)).Value2 = Data(0)
End With
End With
End Sub
You can reference a sheet by its codename, however it is a different format and must be in ThisWorkbook. A drawback is that you cannot reference a sheet in another workbook by its codename. Worksheets("PQ Total US").Activate versus PQTotalUS.Activate. If your goal is to shorten the code and not have to repeat a long name, then another option is to do the following:
Dim wb1 as Workbook
Dim ws1 as Worksheet
Set wb1 = Workbooks("Power Query Meijer_Walmart_Total US xAOC.xlsm")
Set ws1 = wb1.Worksheets("PQ Total US")
With ws1
'Do something
End with

Making sheet name the same as cell value

I am currently working on macro in a workbook with multiple worksheets, that aims to show and hide certain worksheets based on the values in a master worksheet. The worksheet names are also contained in the master worksheet and the main procedure looks at these values when referencing to a worksheet it needs to show or hide. The problem with this method is that, the macro will produce errors if the user changes the worksheet tab names. I was hoping to insert an additional procedure that makes the tab names of each worksheet equal to the values in the respective cell of the master worksheet. I came up with the following:
Sub SheetName()
If Not ActiveWorkbook Is ThisWorkbook Then Exit Sub
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
DataImport.Range("A13").Value = Sheet1.Name
End Sub
This code works fine but there are about 100+ worksheets in this workbook. I was wondering if there is a more efficient way to do this, as opposed to typing the same procedure 100 times. I've tried storing the worksheet code names in an array and looping the same procedure through the array, for example:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws(0 To 2) As Worksheet
Set ws = Array(Sheet1, Sheet2, Sheet3)
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub
but the error message "Can't Assign to Array" shows up. Sorry in advance if my code looks garbage, I am still new to VBA and I still have quite a lot to learn.
If you list the sheet codenames in ColA of your master sheet, then this code will update columns B and C with the current sheet tab names and indexes respectively:
Sub UpdateIndex()
Dim ws As Worksheet, cn As String, m
For Each ws In ThisWorkbook.Worksheets
cn = ws.CodeName
If cn <> DataImport.CodeName Then
'look for the codename in the Import sheet
m = Application.Match(cn, DataImport.Columns(1), 0)
If Not IsError(m) Then
'got a match - update this row
DataImport.Cells(m, "B").Value = ws.Name 'tab name
DataImport.Cells(m, "C").Value = ws.Index 'sheet index
End If
End If
Next ws
End Sub
Assumes you set the code name for your "Data Import" worksheet to DataImport.
If your code is driven by the sheet codename, it doesn't matter whether the user renames the tabs or changes the sheet order.
For your second attempt, you can use Excel built-in Sheets object and Workbook.Sheets collection:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws As Excel.Sheets
Set ws = ThisWorkbook.Sheets
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub

Find Sheet Name with table on it

I am trying to find the sheet name that has a specific table name on it. For example:
Set sheetNM = ActiveWorkbook.Names("ratetable").RefersToRange.Parent.Name
Something like that, but would pull the name of the sheet, so I can activate that sheet in order to pull information from it.
This is not something I recommend but as you are referencing the ActiveWorkbook, you can drop the ActiveWorkbook and retrieve it simply as,
dim pws as worksheet, sws as string
sws = range("ratetable").parent.name
set pws = range("ratetable").parent
debug.print sws & " - " & pws.name
While a structured table (aka ListObject object) is listed in the Formulas ► Name Manager, it does not have all of the properties of a defined name. Unfortunately, everything you can do with a name you cannot always do with a ListObject as a ListObject's parent is the Worksheet object, not the workbook.
You can use error trapping to find the sheet containing a table with a given name:
Function FindTableSheet(TableName As String) As String
Dim ws As Worksheet
Dim LO As ListObject
Dim shName As String
For Each ws In Sheets
On Error Resume Next
Set LO = ws.ListObjects(TableName)
If Err.Number = 0 Then
FindTableSheet = ws.Name
Exit Function
Else
Err.Clear
End If
Next ws
FindTableSheet = "Not Found"
End Function
To test it, I named one of my sheets "Data" and added a table called "ratetable" to that sheet. I didn't, however, create any table called "table tennis". I then ran:
Sub test()
Debug.Print FindTableSheet("ratetable")
Debug.Print FindTableSheet("table tennis")
End Sub
With the output:
Data
Not Found
I know this post is old, but for what it's worth, I think the OP was on the right track (looking for the parent name) with the initial code that you originally posted. Calling the table's parent works for me:
ActiveSheet.ListObjects("TableName").Parent.Name

Resources