I have a unit matrix that illustrates work items for an apartment complex. It expands to 5 floors and has more work items than just the kitchen scope. My end goal is to have a sheet for each unit, listing the specific items needed for that unit. It would be very helpful once construction begins.
I want to do 2 things. 1 - Create new sheets for each unit (C5:C124) using the template. 2 - Copy over the information based on what is marked with an "X"
I know how to create a macros that will create blank sheets from the number of units I have. I'm stuck on integrating the template.
Thank you for reading.
Unit Scope Matrix
Template
Edit 1:
Here is my new code that can take a range of room#s and create new sheets from it. Now I would like to copy and paste the the row next the the according room# cell and paste in the appropriate sheet.
Sub CreateSheets()
Dim rng As Range
Dim cell As Range
On Error GoTo Errorhandling
'Creates popup box asking for the room numbers
Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Create sheets", _
Default:=Selection.Address, Type:=8)
For Each cell In rng
'Check if cell is not empty
If cell <> "" Then
'Insert worksheet and name the worksheet based on cell value
Sheets("Template").Copy After:=Sheets("Unit Types")
'Name new sheet based off two cells on Bid Summary List Cells (Bi and Di)
ActiveSheet.Name = "UNIT-" & cell
'This is where I think I should add the copy/paste lines... but I don't know how.
'Copy unit# row and paste in correct worksheet
'Range("XX:XX").Copy Range("XX:XX")
End If
'Continue with next cell in cell range
Next cell
'Go here if an error occurs
Errorhandling:
'Stop macro
End Sub
The code to copy the template and rename it is easy enough to make. Start recording, do one manually, stop recording, then press Alt-F11 to see how it's done, then steal from that to make your own function.
I suspect you'll end up with something that looks like
Function NewSheet(nm as String) as Worksheet
Dim template As Worksheet
set template = ActiveWorkbook.sheets('template')
set NewSheet = template.copy(ActiveWorkbook)
NewSheet.name = nm // change the tab name
NewSheet range('B1') = nm // add to the sheet as well
End Function
(warning: syntax and method names might unintentionally be wrong, this is intended to give you a head start, not do it for you)
and then you'll need to write a macro that loops through column C and calls your function. In this case you can ignore that NewSheet returns a new Worksheet object, but this way provides flexible code for future needs. Also, by isolating what you need to do to make a new worksheet as its own function that's called multiple times, It's easier to reason through and test, and the looping code that calls it is much easier to read as well.
Try searching for "Excel VBA looping examples" to get a head start on looping if you are unfamiliar.
Related
This question already has answers here:
Excel VBA Sum from Multiple Sheets
(3 answers)
Closed 3 years ago.
I need to sum values across multiple sheets. The sheets will always have different names as they are set by the date.
I have a summary sheet as the first sheet in my workbook.
From a field in my summary sheet, I'd like to read through each sheet and if the value of the fields match it adds the values together.
For example, pseudo code would be, Go through each worksheet and if SummarySheet.Range("A24").value is in range(G1:G200) sum up the corresponding cell in range("H1:H200").
I've tried sum if and sum product.
I've tried the below code. Which bombed!
For Each Cell In Range("A24:A224")
For Each ws In ThisWorkbook.Worksheets
For Each i In ThisWorkbook.ActiveSheet.Range("G2:H200")
If Cell.Value = i.Value Then
ActiveCell.Offset(0, 1).Select
Cell.Value = Cell.Value + i.Value
End If
Next i
Next ws
Next Cell
Your code is referencing "ActiveSheet" and "ActiveCell" but it's not activating anything within the loop.
It is very difficult to guess what your code is trying to do. This answer is more about good coding practice than specific recommendations. My hope is this will allow you to correct your own code.
ActiveCell.Offset(0, 1).Select serves no purpose. The ActiveCell is the cell containing the cursor. You do not position the cursor at the beginning of the routine to a first cell and you neither read from nor write to the ActiveCell during the rest of the macro.
For Each ws In ThisWorkbook.Worksheets serves no purpose since you do not use ws. In For Each i In ThisWorkbook.ActiveSheet.Range("G2:H200") did you mean to write For Each i In ws.Range("G2:H200")? I cannot see anywhere else you might have meant to use ws.
Each Cell In Range("A24:A224") references the ActiveSheet. This is whatever worksheet happens to be active when the macro was started. My guess is that Range("A24:A224") is in the summary worksheet. If the user happens to be looking at another worksheet when they start the macro, that other worksheet is the ActiveSheet and not the summary worksheet. I assume you want to accumulate totals in the summary worksheet. If the wrong worksheet is active when the macro is started, that worksheet will be corrupted beyond recovery. UnDo cannot undo what a macro has done so you will have to revert to the previous copy of the workbook. I hope you create a new copy of the workbook before trying experimental macros so you can revert to an undamaged version. You need something like:
Dim WshtSumm As Worksheet
Set WshtSumm = Worksheets("Summary")
For Each Cell In WshtSumm.Range("A24:A224")
: : : : : : :
Next
In my opinion, you should not use names like Cell because it is too similar to the reserved word Cells. You should not use names like i because such names are meaningless. Perhaps it does not matter in such a small macro but, as your macros get bigger, meaningful names will be a real help when you or someone else looks at this macro in six or twelve months. Few macros last unchanged for ever; they are updated every few months to address changing requirements. I do not know what Cell and i represent but perhaps CellSumm and CellData would be better names.
Consider ThisWorkbook.Worksheets and Range("A24:A224"). I have just told you that you should have identified which worksheet holds Range("A24:A224"). This was because your workbook holds several worksheets any of which could be active. If you have a workbook that has only one worksheet, Range("A24:A224") might be OK. Personally, I avoid unqualified ranges because it is so easy to add a new worksheet. However, is it likely that you will have two workbooks or more workbooks open? Yes, it is possible to run a macro in one workbook from another workbook but is this likely? ThisWorkbook identifies the workbook holding the macro. If you are concerned that the wrong workbook will be active, you are absolutely correct to specify which collection of worksheets you wish to access because each workbook has its own collection. However, Worksheets on its own will normally be sufficient. This is something you need to think about, particularly as your macros get more complicated: do I need to qualify this range or worksheet or anything of which you might have more than one?
Consider:
For Each ws In ThisWorkbook.Worksheets
For Each i In ws.Range("G2:H200")
I have not qualified ws because a worksheet has a property Parent which identifies its workbook. You qualified ws when you created it.
One of the worksheets in ThisWorkbook.Worksheets will be the summary worksheet. Do you want to examine cells in the summary worksheet? I assume not. You need something like:
Dim WshtSumm As Worksheet
Dim WshtOther As Worksheet
Set WshtSumm = Worksheets("Summary")
For Each WshtOther In Worksheets
If WshtOther.Name <> WshtSumm.Name Then
: : : : : : :
End If
Next
This code only examines worksheets whose name does not match the summary worksheet's name. Whenever you look through an entire collection of something, you need to ask yourself: do I really want to look at everyone?
Consider:
If Cell.Value = i.Value Then
ActiveCell.Offset(0, 1).Select
Cell.Value = Cell.Value + i.Value
End If
Where you have written ActiveCell, I suspect you meant Cell giving:
If Cell.Value = i.Value Then
Cell.Offset(0, 1).Select
Cell.Value = Cell.Value + i.Value
End If
This would make a little more sense but not much. You search Range("G2:H200") of every worksheet for a value that matches a value in Range("A24:A224") of the summary worksheet. If you find that matching value you add it to the next cell in Range("A24:A224"). You tell us nothing about the summary worksheet or the data worksheets so this may be sensible but it does not feel sensible. If you find a match on "A30", you add the value of "A30" to "A31". But then you search for a match on the amended "A31". I cannot imagine any requirement for which this would be sensible.
Even if I thought this was sensible, I don’t think it will work. If I write:
For X = 1 to 10
: :
Next
I cannot change the value of X within the For Loop. I have not tried recently but my recollection is that the attempt to change X is ignored. You are trying to change the equivalent of X for a For Each statement. I have not tried but I suspect your attempt to change Cell will fail. Even if it can change Cell you should not. Select is a slow command and you should only use it if it is essential. Try something like:
If Cell.Value = i.Value Then
Cell.Offset(0, 1).Value = Cell.Offset(0, 1).Value + i.Value
End If
I hope the above helps. If it does not, please provide details of the two ranges so I can better understand what you are trying to do.
I just tried this and it worked perfect.
Sub GenerateTheFormula()
Dim x, Formula
Formula = "=SUM(" 'Formula begins with =SUM(
For x = 3 To Sheets.Count
Formula = Formula & Sheets(x).Name & "!A1," 'Add SheetName and Cell and Comma
Next x
Formula = Left(Formula, Len(Formula) - 1) & ")" 'Remove trailing comma and add parenthesis
Range("B1").Formula = Formula 'Where do you want to put this formula?
End Sub
Idea from here:
Excel VBA Sum from Multiple Sheets
What are you trying to accomplish?
I'm trying to mirror the contents of a row of respective cells from one sheet to another. However, the caveat here are: I'm restricted to MS Excel not Access - I can use modules, the initials in column B are to be used as the condition to populate the corresponding sheets. Like: Primary key in MS Access and finally the sheets should be populated in real time; nothing should have to be run.
Said spreadsheet attached here.
What have you tried so far?
a. Well, I tried the =Value(x) and =Grand Budget!A(x) formulas. I setup the corresponding initials worksheets with the respective initials in the main sheet so for example: on sheet "Grand Budget" all NA initials and data in the corresponding row i.e. Description, Vendor and Amount will be mirrored on worksheet "NA" It works great until the third caveat is unfulfilled: it doesn't work in real time because I cannot predict what the next initial will be so I can't setup the next cell with a formula.
b. I also tried filtering the "Grand Budget" sheet by initials in column B, selecting the needed row data, named it and imported the named table to the corresponding initial worksheet. Source.
What do you have in mind - conceptually?
I'm thinking, it's time for modules or if someone knows a hidden excel formula, lay it on me. all I have right is an if statement in c++ in my mind: if(current_cell == desired_initial) {populate()};
I'm willing to aid in interpreting anything that may have been transposed incorrectly.
#peter
update on progress, I require assistance on how to populate the respective sheets. thank you!
Option Explicit
' Create a new sheet for new initials.
Sub CreateNewSheet(Initials As String)
'Checks whether a sheet with the name "Initials" exists
'Creates a new sheet if it doesn't exist yet.
If SheetExists("Initials") Then
MsgBox "Yay! the sheet exists"
Else
MsgBox "Boo! the sheet doesn't exist; I shall create a new one!"
'Creates a new sheet if it doesn't exist yet.
CreateSheet (Initials)
End If
End Sub
Function SheetExists(Initials As String)
On Error GoTo no:
WorksheetName = Worksheets(Initials).Name
SheetExists = True
Exit Function
no:
SheetExists = False
End Function
Private Sub CreateSheet(Initials)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Initials
End Sub
Private Sub sbClearEntireSheetOnlyData()
Sheets("Initials").Cells.ClearContents
End Sub
Private Sub MatchCase(Initials)
Dim x As Integer
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("A3", Range("A3").End(xlDown)).Rows.Count
' Select cell a3.
Range("A3").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub
Apparently there is no way to uniquely identify the rows on the Grand Budget sheet, we only know the sheet on which the row should go.
So if you really need to do this Real Time, I'm afraid you'll have to repopulate the entire user-sheet whenever there is a change anywhere in columns C-E of the budget sheet. And if there's a change in column B, you'll have to completely repopulate 2 user-sheets...
That tends to be a very error-prone process, so it's probably best to completely repopulate all user-sheets ...
My advice would be to ask your client to change the requirements... For instance, ask them if it's okay to have some Recalculate button to start your process.
If your client really doesn't want to use a button, you could ask if it's okay if your macro (which repopulates all user-sheets) starts automatically whenever you open the workbook and whenever you leave the Grand Budget sheet (which in effect also is the only input sheet).
By the way: What do you want to happen if they put nonexistent initials in column B?
Update: "I just spoke with said client, and i quote: "do what you must!" I like the recalculate button idea, please do pitch it to me!" – Nana Amponsah
If you don't have much experience with vba, it might be best to start with the second part: Create a new sheet for new initials.
Option Explicit
Sub CreateNewSheet(Initials As String)
'Checks whether a sheet with the name "Initials" exists
'Creates a new sheet if it doesn't exist yet.
'*** Your code goes here ***
End Sub
Please Note: Before you start, you should make a backup of the original workbook.
The first part of this page tells you how to make a module for your program.
And you might have a look at:
https://superuser.com/questions/1041635/how-can-i-tell-if-sheet-a-exists-in-a-workbook
How to Add a Named Sheet at the end of all excel sheets
I'm trying to write some code that selects certain sheets (not all, and the sheets aren't all next to each other either), clears the same range of cells from each, unselects them, selects another group of sheets, clears the same range from each, etc. Here's the code.
ActiveWorkbook.Sheets(Array("J2a", "J7", "J10", "J11", "J13", "J17", "J18", "J19")).Select
Range("C12:E14, C22:E24, C32:E34, C42:E44, C52:E54, C62:E64, C72:E74,C82:E84, C92:E94, C102:E104, C112:E114, C122:E124, C132:E134, C142:E144, C152:E154").ClearContents
ThisWorkbook.Worksheets("Control").Activate
The problem is that it only clears the contents from the active sheet (which is the first one in the select list). So I changed the code to the following as I thought there must be a way to clear contents on multiple sheets without selecting the sheets:
ActiveWorkbook.Sheets(Array("J2a", "J2b", "J7", "J10", "J11", "J13 DM", "J13 DS", "J17", "J18", "J19")).Range("C12:E14, C22:E24, C32:E34, C42:E44, C52:E54, C62:E64, C72:E74, C82:E84, C92:E94, C102:E104, C112:E114, C122:E124, C132:E134, C142:E144, C152:E154").ClearContents
However now I get an error that says 'Object doesn't support this property or method.
What am I doing wrong? the two lines seem to work independently...Also for my own understanding, what is the object in the error? ActiveWorkbook?
You can use something like the code below. This will go through all the sheets that have their name in the array sheetNamesArray and clear every range that you defined in rangesArray.
If you want to clear other sheets with other ranges, I suggest that you repeat this operation with other values.
Note: This assume that all of your sheets are in the same Workbook.
Dim sheetNamesArray
Dim rangesArray
'Array with the names of all of your sheets
sheetNamesArray = Array("Sheet1", "Sheet2", "Sheet3")
'Array with all of your ranges
rangesArray = Array("A2:B2", "A4:B4", "A6:B6")
'Go through each sheet in the array
For Each sheetName In sheetNamesArray
'Go to each range in the sheet
For Each rangeName In rangesArray
'Clear the value
ThisWorkbook.Sheets(sheetName).Range(rangeName).Clear
Next rangeName
Next sheetName
I have 2 tables on 2 separate sheets of an MS Excel 2007 workbook, like below:
===========================
no. f_name l_name
===========================
13 Little Timmy
1 John Doe
17 Baby Jessica
---------------------------
===========================
no. f_name l_name
===========================
1 john Tim
16 kyle joe
14 Baby katy
22 qbcd wsde
---------------------------
Both have the same columns, but they can have different data.
I want to combine the data of both tables vertically i.e. a single table with all the data in a 3rd separate sheet.
If possible, I want to add another column with the sheet name from where the row came.
===================================
SheetName no. f_name l_name
===================================
Sheet1 13 Little Timmy
Sheet1 1 John Doe
Sheet1 17 Baby Jessica
Sheet2 1 john Tim
Sheet2 16 kyle joe
Sheet2 14 Baby katy
Sheet2 22 qbcd wsde
-----------------------------------
Can it be done without using macros?
This answer deals with Structured Tables as interpreted by Excel. While the methods could easily be transcribed to raw data matrixes without assigned table structure, the formulas and VBA coding for this solution will be targeted at true structured tables.
Preamble
A third table can maintain the combined data of two tables with some native worksheet formulas but keeping the third table sized correctly as rows are added or deleted to/from the dependent tables will require either manual resizing operations or some VBA that tracks these changes and conforms the third table to suit. I've included options to add both the source table's worksheet name as well as some table maintenance VBA code at the end of this answer.
If all you want is an operational example workbook without all the explanation, skip to the end of this answer for a link to the workbook used to create this procedure.
Sample data tables
I've used the OP's sample data to construct two tables named (by default) Table1 and Table2 on worksheets Sheet1 and Sheet2 respectively. I've intentionally offset them by varying degrees from each worksheet's A1 cell in order to demonstrate a structured table's ability to address either itself or another structured table in a formula as a separate entity regardless of its position on the parent worksheet. The third table will be constructed in a similar manner. These offsets are for demonstration purposes only; they are not required.
Step 1: Build the third table
Build the headers for the third table and select that future header row and at least one row below it to base the Insert ► Tables ► Table command upon.
Your new empty third table on the Sheet3 worksheet should resemble the following.
Step 2: Populate the third table
Start by populating the first cell in the third table's DataBodyRange. In this example, that would be Sheet3!C6. Type or paste the following formula in C6 keeping in mind that it is based on the default table names. If you have changed your tables names, adjust accordingly.
=IFERROR(INDEX(Table1, ROW([#[no.]])-ROW(Table3[#Headers]),COLUMN(A:A)), INDEX(Table2, ROW([#[no.]])-ROW(Table3[#Headers])-ROWS(Table1),COLUMN(A:A)))
The INDEX function first retrieves each available row from Table1. The actual row numbers are derived with the ROW function referencing defined pieces of the structured table together with a little maths. When Table1 runs out of rows, retrieval is passed to a second INDEX function referencing Table2 by the IFERROR function and its sequential rows are retrieved with the ROW and ROWS functions using a bit more maths. The COLUMN function is used as COLUMN(A:A) which is going to retrieve the first column of the referenced table regardless of where it is on the worksheet. This will progress to the second, third, etc. column as the formula is filled right.
Speaking of filling right, fill the formula right to E6. You should have something that approximates the following.
Step 2.5: [optional] Add the source table's parent worksheet name
Grab Table3's sizing handle (indicated by the orange arrow in the sample image below) in the lower right hand corner and drag it right one column to add a new column to the table. Rename the header label to something more appropriate than the default. I've used Sheet as a column label.
While you cannot retrieve the worksheet name of the source table directly, the CELL function can retrieve the fully qualified path, filename and worksheet of any cell in a saved workbook¹ as one of its optional info_types.
Put the following formula into Table3's empty cell in the first row of the new column you have just created.
=TRIM(RIGHT(SUBSTITUTE(CELL("filename", IF((ROW([#[no.]])-ROW(Table3[#Headers]))>ROWS(Table1), Table2, Table1)), CHAR(93), REPT(CHAR(32), 999)), 255))
Complate populating Table3
If you are not planning on finishing this small project with some VBA to maintain Table3's dimensions when rows are added or deleted from either of the two source tables then simply grab Table3's resizing handle and drag down until you have accumulated all of the data from both tables. See the bottom of this answer for a sample image of the expected results.
If you are planning to add some VBA, then skip the full population of Table3 and move on to the next step.
Step 3: Add some VBA to maintain the third table
Full automation of a process that is triggered by changes to a worksheet's data is best handled by the worksheet's Worksheet_Change event macro. Since there are three tables involved, each on their own worksheet, the Workbook_SheetChange event macro is a better method of handling the change events from multiple worksheets.
Open the VBE with Alt+F11. Once you have it open, look for the Project Explorer in the upper left. If it is not visible, then tap Ctrl+R to open it. Locate ThisWorkbook and right-click then choose View Code (or just double-click ThisWorkbook).
Paste the following into the new pane titled something like Book1 - ThisWorkbook (Code).
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case Sheet1.Name
If Not Intersect(Target, Sheet1.ListObjects("Table1").Range.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Call update_Table3
End If
Case Sheet2.Name
If Not Intersect(Target, Sheet2.ListObjects("Table2").Range.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Call update_Table3
End If
End Select
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Private Sub update_Table3()
Dim iTBL3rws As Long, rng As Range, rngOLDBDY As Range
iTBL3rws = Sheet1.ListObjects("Table1").DataBodyRange.Rows.Count
iTBL3rws = iTBL3rws + Sheet2.ListObjects("Table2").DataBodyRange.Rows.Count
iTBL3rws = iTBL3rws + Sheet3.ListObjects("Table3").DataBodyRange.Cells(1, 1).Row - _
Sheet3.ListObjects("Table3").Range.Cells(1, 1).Row
With Sheet3.ListObjects("Table3")
Set rngOLDBDY = .DataBodyRange
.Resize .Range.Cells(1, 1).Resize(iTBL3rws, .DataBodyRange.Columns.Count)
If rngOLDBDY.Rows.Count > .DataBodyRange.Rows.Count Then
For Each rng In rngOLDBDY
If Intersect(rng, .DataBodyRange) Is Nothing Then
rng.Clear
End If
Next rng
End If
End With
End Sub
These two routines make extensive use of the Worksheet .CodeName property. A worksheet's CodeName is Sheet1, Sheet2, Sheet3, etc and does not change when a worksheet is renamed. In fact, they are rarely changed by even the more advanced user. They have been used so that you can rename your worksheets without having to modify the code. However, they should be pointing to the correct worksheets now. Modify the code if your tables and worksheets are not the same as given. You can see the individual worksheet codenames in brackets beside their worksheet .Name property in the above image showing the VBE's Project Explorer.
Tap Alt+Q to return to your worksheets. All that is left would be to finish populating Table3 by selecting any cell in Table1 or Table2 and pretending to modify it by tapping F2 then Enter↵. Your results should resemble the following.
If you have followed along all the way to here then you should have a pretty comprehensive collection table that actively combines the data from two source 'child' tables. If you added the VBA as well then maintenance of the third collection table is virtually non-existent.
Renaming the tables
If you choose to rename any or all of the three tables, the worksheet formulas will instantly and automatically reflect the changes. If you have opted to include the Workbook_SheetChange and accompanying helper sub procedure, you will have to go back into the ThisWorkbook code sheet and use Find & Replace to make the appropriate changes.
Sample Workbook
I've made the fully operational example workbook available from my public DropBox.
Table_Collection_w_Sheetname.xlsb
¹ The CELL function can only retrieve the worksheet name of a saved workbook. If a workbook has not been saved then it has no filename and the CELL function will return an empty string when asked for the filename.
You can activate the Office Clipboard (arrow at bottom right of clipboard section on Ribbon Home Tab). Copy both ranges then use the Paste All command as shown below.
You would still need to fill down the sheet name in an extra column first though which can be done by double-clicking the fill handle.
Update
To get the same results with formulas try filling down this for the sheet name:
=IF(ROW()<=COUNTA(Sheet1!A:A),"Sheet1",IF(ROW()<COUNTA(Sheet1:Sheet2!A:A),"Sheet2",""))
and then fill down and across this formula for the values in the tables:
=IF(ROW()<=COUNTA(Sheet1!A:A),Sheet1!A2,IF(ROW()<COUNTA(Sheet1:Sheet2!A:A),INDEX(Sheet2!A:A,ROW()-COUNTA(Sheet1!A:A)+1),""))
lori_m made a really good contribution that I built upon by using Microsoft Excel Tables and structured references.
First make a column in your output table called RowID which contains the row number within the table and then use this to fill the data values.
=IF( INDIRECT("Table3[RowId]")<=ROWS(Table1)
,INDEX(Table1[column1],INDIRECT("Table3[RowId]"))
,INDEX(Table2[Column1],INDIRECT("Table3[RowId]")-ROWS(Table1)))
There is a detailed explanation of how this works on my blog as it was too long to include here.
A slight modification to Jeeped's code.
If you happen to use a similar approach, but with several tables (e.g. more than 10), then it will be rather cumbersome to attempt to manually add every name of every table. This is also a problem if you change names of the tables, since the names are hard-wired in VBA. To avoid additional work, consider this:
So, assume the following:
On each worksheet there is one or several tables, but they have similar structure.
There are only tables on worksheets - no other members of ListObjects collection are being present.
Every time we edit a table on a sheet, this will trigger an update in master table (table 3).
Then the Workbook_SheetChange Sub in the example above could look like the following:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim tbl As ListObject
For Each tbl In ActiveSheet.ListObjects
If Not Intersect(Target, tbl.Range.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Call update_Table
End If
Next tbl
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Edit. The second routine will then look like:
Private Sub update_Table()
Dim iTBL3rws As Long, rng As Range, rngOLDBDY As Range
Dim tbl As ListObject
Dim sht As Worksheet
iTBL3rws = 0
' consider all tables, excluding master table
For Each sht In ThisWorkbook.Worksheets
For Each tbl In sht.ListObjects
If tbl.Name <> "Table3" Then
iTBL3rws = iTBL3rws + tbl.DataBodyRange.Rows.Count
End If
Next tbl
Next sht
iTBL3rws = iTBL3rws + Sheet3.ListObjects("Table3").DataBodyRange.Cells(1, 1).Row - Sheet3.ListObjects("Table3").Range.Cells(1, 1).Row
With Sheet3.ListObjects("Table3")
Set rngOLDBDY = .DataBodyRange
.Resize .Range.Cells(1, 1).Resize(iTBL3rws, .DataBodyRange.Columns.Count)
If rngOLDBDY.Rows.Count > .DataBodyRange.Rows.Count Then
For Each rng In rngOLDBDY
If Intersect(rng, .DataBodyRange) Is Nothing Then
rng.Clear
End If
Next rng
End If
End With
End Sub
This routine differs from previous one by eliminating preprogrammed cases. When there is a change registered on active worksheet, then any table in this worksheet which is about to be changed will trigger update_Table procedure.
Im using this code/formula. works well for my needs only thing i would like to know is how do i make a better cell formula so i can use 3+ tables as a reference. currently im just nesting a bunch of iferror statements within the iferror
=IFERROR(INDEX(Table1, ROW([#Date])-ROW(Table3[#Headers]),COLUMN(A:A)),IFERROR( INDEX(Table2, ROW([#Date])-ROW(Table3[#Headers])-ROWS(Table1),COLUMN(A:A)), IFERROR(INDEX(Table4, ROW([#Date])-ROW(Table3[#Headers])-ROWS(Table2)-ROWS(Table1),COLUMN(A:A)),INDEX(Table5, ROW([#Date])-ROW(Table3[#Headers])-ROWS(Table2)-ROWS(Table1)-ROWS(Table4),COLUMN(A:A)))))
Im also using the
I have limited experienced of writing macros, and I'm looking to update a current spreadsheet used at work. Currently we copy the entire Master worksheet and paste it into other worksheets before sorting for the "X" in certain columns to delete other rows on the master worksheet.
What I am looking to do is search the Master Sheet, and if Column B has an "X" then copy the entire row and paste it into a worksheet named "Column B". Then, once Column B was completed and pasted, it would look at Column D. If Column D had an "X", it would copy the entire row and paste it in worksheet tab named "Column D".
Thanks in advance!
Approach
I should have included this in the first version of my answer.
My solution depends on AutoFilter. I first offer a play solution that demonstrates this approach by:
making rows not containing X in column B invisible
making rows not containing X in column D invisible
clearing the AutoFilter
If this approach appeals, I refer you to my answer to another question which creates a menu so the user can select which filter they want.
If this approach does not appeal, I offer a second solution which involves copying the visible rows left by each filter to other worksheets.
Introduction
You say "I have limited experienced of writing macros" which I take to mean you have some experience. I hope I have the level of explanations correct. Come back with questions if necessary.
I assume your workbook is on a server. I assume someone has write access to update the master worksheet while others open read-only copies so they can look at the subsets of interest to them. If my assumptions are about right, take a copy of the workbook for you to play with. Don't worry about others updating the master version of the workbook, we will copy the final version of the code from your play version when we have finished.
Step 1
Copy the first block of code to a module within the play version. Near the bottom you will find Const WShtMastName As String = "SubSheetSrc". Replace SubSheetSrc by the name of your master worksheet.
Note: the macros within this block are named CtrlCreateSubSheetB and CreateSubSheetB because they are play versions. The real versions are named CtrlCreateSubSheet and CreateSubSheet.
Run macro CtrlCreateSubSheetB. You will see the Master worksheet but only those rows with an "X" in column B. Click on the message box.You will see the Master worksheet but only those rows with an "X" in column D. Click on the message box and the filter will disappear. Switch to the VB Editor if you are not already there. In the Immediate Window (Click Ctrl+G if it is not visible) and you will see something like:
Rows with X in column 2: $A$1:$G$2,$A$4:$G$5,$A$8:$G$9,$A$11:$G$12,$A$14:$G$14, ...
Rows with X in column 4: $A$1:$G$1,$A$3:$G$3,$A$5:$G$5,$A$7:$G$7,$A$10:$G$10, ...
Now work down macros CtrlCreateSubSheetB and CreateSubSheetB. You must understand how these macro have created the effects you saw. If necessary use VB Help, the Debugger and F8 to step down the macros to identify what each statement is doing. I believe I have given you enough information but come back with questions if necessary.
' Option Explicit means I have to declare every variable. It stops
' spelling mistakes being taken as declarations of new variables.
Option Explicit
' Specify a subroutine with two parameters
Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)
' This macro applies an AutoFilter based on column ColSrc
' to the worksheet named WShtSrcName
Dim RngVis As Range
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible rows
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
' Output a string to the Immediate window.
Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address
End Sub
' A macro to call CreateSubSheetB for different columns
Sub CtrlCreateSubSheetB()
Const WShtMastName As String = "SubSheetSrc"
Dim WShtOrigName As String
' Save the active worksheet
WShtOrigName = ActiveSheet.Name
' Make the master sheet active if it is not already active so
' you can see the different filtered as they are created.
If WShtOrigName <> WShtMastName Then
Sheets(WShtMastName).Activate
End If
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Call CreateSubSheetB(WShtMastName, 2)
Call MsgBox("Click to continue", vbOKOnly)
Call CreateSubSheetB(WShtMastName, 4)
Call MsgBox("Click to continue", vbOKOnly)
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
' Restore the original worksheet if necessary
If WShtOrigName <> WShtMastName Then
Sheets(WShtOrigName).Activate
End If
End Sub
Step 2
If my assumptions about how you use the workbook are correct you may not need much more. If John and Mary each open a read-open copy of the master workbook then John could use the B filter while Mary uses the D filter. If this sounds interesting, look at my answer to copy row data from one sheet to one or more sheets based on values in other cells.
Step 3
If you do not like the idea of just using filters and still want to create copies of the B data and the D data, you will need the code below.
The macros within this block are named CtrlCreateSubSheet and CreateSubSheet but are not much different from the B versions above.
In CtrlCreateSubSheet you will need to replace "SubSheetSrc", "SubSheetB" and "SubSheetD" with your names for these worksheets. Add further calls of CreateSubSheet for any further control columns.
Note: these version delete the original contents of the destination sheets although this is not what you have asked for. I have deleted the original contents because (1) what you have adding new rows is more complicated and (2) I do not believe you are correct. If there is some significance to what you requested then come back and I will update the code.
Option Explicit
Sub CtrlCreateSubSheet()
Const WShtMastName As String = "SubSheetSrc"
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Application.ScreenUpdating = False
Call CreateSubSheet(WShtMastName, 2, "SubSheetB")
Call CreateSubSheet(WShtMastName, 4, "SubSheetD")
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
Sub CreateSubSheet(ByVal WShtSrcName As String, ByVal ColSrc As Long, _
ByVal WShtDestName As String)
' This macro applies an AutoFilter based on column ColSrc to the worksheet
' named WShtSrcName. It then copies the visible rows to the worksheet
' named WShtDestName
Dim RngVis As Range
Dim WShtOrigName As String
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible cells
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
If RngVis Is Nothing Then
' There are no visible rows. Since the header row will be visible even if
' there are no Xs in column ColSrc, I do not believe this block can
' be reached but better to be safe than sorry.
Call MsgBox("There are no rows with an X in column " & ColSrc, vbOKOnly)
Exit Sub
End If
' Copy visible rows to worksheet named WShtDestName
With Sheets(WShtDestName)
' First clear current contents of worksheet named WShtDestName
.Cells.EntireRow.Delete
' Copy column widths to destination sheets
Sheets(WShtSrcName).Rows(1).Copy
.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
' I do not recall using SpecialPaste column widths before and it did not
' work as I expected. Hunting around the internet I found a link to a
' Microsoft page which gives a workaround. This workaround worked in
' that it copied the column widths but it left row 1 selected. I have
' added the following code partly because I like using FreezePanes and
' partly to unselect row 1.
WShtOrigName = ActiveSheet.Name
If WShtOrigName <> WShtDestName Then
.Activate
End If
.Range("A2").Select
ActiveWindow.FreezePanes = True
If WShtOrigName <> WShtDestName Then
Sheets(WShtOrigName).Activate
End If
' Copy all the visible rows in the Master sheet to the destination sheet.
RngVis.Copy Destination:=.Range("A1")
End With
End Sub
Step 4
Once you have deleveloped the macros to your satisfaction, you will need to copy the module containing the macros from your play version to the master version. You can export the module and then import it but I think the following is easier:
Have both the play and master versions of the workbook open.
Create an empty module in the master version to hold the macros.
Select the macros in the play version, copy them to the scratchpad and then paste them to the empty module in the master version.
You will need to teach whoever is responsible for updating the master version to run the macros whenever a significant update is complete. You could use a shortcut key or add the macro to the toolbar to make the macro easy to use.
Summary
Hope all that makes sense. Do ask questions if necessary.
More simply:
Sub Columns()
If WorkSheets("Sheet1").Range("B1") = x Then
WorkSheets("Column B").Range("B2") = WorkSheets("Sheet1").Range("B2:B" & Rows.Count).End(xlup).Row
End if
If WorkSheets("Sheet1").Range("D1") = x Then
WorkSheets("Column D").Range("D2") = WorkSheets("Sheet1").Range("D2:D" & Rows.Count).End(xlup).Row
End if
End Sub