Concat tables in different excel worksheet - vba

Question
I'm trying to do something that may be very simple using Excel but I can't find how to do it.
I have several worksheets, each one contains a single table. To give you an example, here are two of my worksheets :
First worksheet. Please note that lines are green.
Some data. Without 's', sorry :-)
Second one. Lines are grey but cells can be red. Headers are NOT the same
I would like to :
merge those tables into another worksheet
keep style formatting (line color, etc)
when I update a table, the merged one should update too (may be a macro)
Here is a possible output :
Note that same headers are correctly merged.
Can I do this with Excel ? I know that I can do a query (UNION ALL) but doing this doesn't preserve style formatting.
Edit 1
I've tried to build the table using microsoft queries. Here is my query :
SELECT * FROM `C:\Users\cflodrops\Downloads\comptes.xlsx`.`Purchases$` `Purchases$`
UNION ALL
SELECT * FROM `C:\Users\cflodrops\Downloads\comptes.xlsx`.`Sales$` `Sales$`
UNION ALL
SELECT * FROM `C:\Users\cflodrops\Downloads\comptes.xlsx`.`Trades$` `Trades$`
UNION ALL
SELECT * FROM `C:\Users\cflodrops\Downloads\comptes.xlsx`.`Transfers$` `Transfers$`
This request works great, here is the result :
But I still have issues :
style formatting is incorrect (background colors and numbers format)
datas are not synchronized between arrays. It's not an issue, I can create a macro to execute the request whenever I click on a button.

you have a few problems...union can work. Assuming union path from your first edit.
Add placeholder columns on both sheets to allow proper union, OR force placeholders columns in with your t-sql queries.
Add columns to each sheet representing the source OR add these in with your t-sql queries. e.g. 'Sheet1'
On your unioned sheet with the results, add conditional formatting, where the row with the cell of the source type is evaluated, then the entire row is formatted as necessary. e.g. cell A2 has 'Sheet1', then row A is colored green.

If i understand you well, you want to:
copy data preserving formatting from existing sheets and put them into another sheet (new or existing; let's call it "merged data"),
keep one-way synchronization betweem source sheets and "merged sheet", which means when source sheet is changing, a "merged sheet" changes too.
The answer for both issues is YES depending on a way you choose to merge/synchronize/display data...
Method #1 - using copy & paste data one below another
This method will preserve formatting, but there's no chance to update destination table (sheet) when source data have been changed. You'll need to create it every time you want to see merged data.
Method #2 - using Range.CopyFromRecordset method together with UNION statement
If you want to use this method, you have to change your data set into model of relational database. There's no chance for preserving source formatting, but "merged sheet" may be quickly reloaded (a'ka updated).
Both methods of copying data between sheets you'll find here: Copy Data Between Excel Sheets using VBA, but this tip does not provide information about copying data within its originall format. So, i decided to clarify how to achieve that and show/provide code which create destination sheet with merged data.
In my example i have 3 sheets. First and second sheet is used as source of data and the 3. one is used to display merged data. Only 3 columns (A-C) contain data, so ranges to copy are hard-coded.
Option Explicit
'method #1
Private Sub CopyWithFormatting(srcSh As Worksheet, dstSh As Worksheet, Optional sCol As String = "A")
Dim e1 As Long, e2 As Long
On Error GoTo Err_CopyWithFormatting
'last row in src and dst sheet
e1 = srcSh.Range(sCol & srcSh.Rows.Count - 1).End(xlUp).Row
e2 = dstSh.Range(sCol & dstSh.Rows.Count - 1).End(xlUp).Row + 1
'do not refresh screen
Application.ScreenUpdating = False
'copy defined range
srcSh.Range("A2:C" & e1).Copy
'paste below existing data
With dstSh.Range("A" & e2)
.PasteSpecial xlPasteAllUsingSourceTheme
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValidation
End With
Exit_CopyWithFormatting:
On Error Resume Next
'restore default settings
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
Exit Sub
Err_CopyWithFormatting:
MsgBox Err.Description, vbExclamation, "Err no. " & Err.Number
Resume Exit_CopyWithFormatting
End Sub
How to use it?
Sub TestMethod1()
Dim CopiedSheet As Worksheet, DestSheet As Worksheet
'as i mentioned -> 3. sheet is used to merge data
'you can change it by using sheet's name or its index
Set DestSheet = ThisWorkbook.Worksheets(3)
'copy data from sheets into destination sheet
For Each CopiedSheet In ThisWorkbook.Worksheets
'ignore destination sheet
If CopiedSheet Is DestSheet Then GoTo SkipNext
CopyWithFormatting CopiedSheet, DestSheet
SkipNext:
Next
End Sub
Finall note: Feel free to change above code to your needs.

In the third sheet I would have a macro in the Activate event, that pulls the data from from the first two sheets. I would add a hidden column in the third sheet that contains to originating sheet. In your conditional formatting for the third sheet you would need to base your formatting on the value in the hidden column. I can post a sample to clarify if you wish.
EDIT: Added sample
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim Sheet3 As Worksheet
Set Sheet1 = Worksheets(1)
Set Sheet2 = Worksheets(2)
Set Sheet3 = Worksheets(3)
Sheet1.Range("A2:D101").Copy
Sheet3.Cells(2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet2.Range("A2:D101").Copy
Sheet3.Cells(102, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet3.Cells(1, 1).Select
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A201"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Here is an example file.
ConcatSheets Example.xlsm

Related

Excel VB Advanced Filter Copy with Condition

I am trying to put a condition on each row copied. I want all uniques but only if they also have a specific value in another field.
This is what I have to grab all uniques (and it works) but I can't figure out how to get only the rows with a specific value in column J.
r1.Columns(20).AdvancedFilter xlFilterCopy, , Sheet11.Range("A1"), unique:=True
I have tried doing a CriteriaRange but I can't seem to get the syntax correct for it. Additionally I thought about an If statement but logically in my head it means it would fire off the whole list every time it has a true statement, not on a per row basis.
Here is how I thought it might work. But I get a type mismatch error.
r1.Columns(20).AdvancedFilter xlFilterCopy, r1.Columns(10).Value = "November", Sheet11.Range("A1"), unique:=True
Thoughts?
First of all, your Criteria Range should be just that - a Range with the header corresponding to the column to be filtered, and criteria underneath. For example, D1:D2 in this snapshot:
Secondly, you won't be able to copy just a single column (20) while filtering another column (10) in the same step.
You can tweak the Advanced Filter to
First filter the entire list in place based on the criterion provided
And then copy the visible cells in the column in question
Something like this (change Sheet and Range references as needed):
Sub MyFilter()
Dim lastRow As Long
With Sheet1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:B" & lastRow).AdvancedFilter _
Action:=xlFilterInPlace, CriteriaRange:=.Range("D1:D2"), Unique:=True
With .Range("B1:B" & lastRow).SpecialCells(xlCellTypeVisible)
.Copy Sheet2.Range("A1")
End With
.ShowAllData
End With
End Sub
To be able to keep the other parts of the code that worked perfectly. I added a hidden sheet and wrote a macro to copy the filtered results out to the new hidden sheet. Then I ran my original code against the filtered data on that hidden sheet.
Sub FilterLiveToDataSheet()
' Unhide Required Sheets
Sheets("Original-Data").Visible = True
Sheets("Filtered-Data").Visible = True
' Delete Old Data
Sheets("Filtered-Data").Select
Cells.Select
Selection.ClearContents
' Copy Filtered Data
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("TBL_ATTR_Spend").Range.AutoFilter Field:=10, _
Criteria1:="Delta"
Cells.Select
Selection.Copy
' Paste to Data Sheet
Sheets("Filtered-Data").Select
Cells.Select
ActiveSheet.Paste
' Unfilter Original Data Page
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
' Hide Required Sheets
Sheets("Original-Data").Visible = False
Sheets("Filtered-Data").Visible = False
' Go to Results Sheet
Sheets("Results").Select

How to copy individual value combinations from three columns to a different sheet

I'm a beginner so bear with me
The code I'm using now is this, given to me by user "Xabier", slightly edited by me. This copies the rows with a certain document# into a separate sheet, thus giving me a list:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("A2:N2" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
wsDestination.Range("A" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
Now what I want to do is create something like a header for the document containing data regarding the origin of the imports.
This data is the "Import#", "Invoice#", "Supplier" and "Invoice date". Basically for every unique Invoice# I need to create a unique entry even if the supplier or the import# is the same.
And I can't copy the entire row, I just need to copy certain cells in each row.
After I actually figure out how all this works, this is how the document is going to look.
this is actually a pretty involved solution that StackOverflow is not meant for. Instead, i'll give you an idea of how you could implement this yourself.
loop through filtered data
if not first loop, check if the previous new sheet's invoice number matches this one
check that new sheet is not too full to add invoice
copy this row's invoice information to new sheet
looping through filtered data
copying data from cell to cell

Combine filtered data from multiple worksheets to a single worksheet

Have a workbook which utilizes multiple worksheets (15+) that are used to hold numerous lines of manufacturer data. We select items for order by entering quantities desired via a specific column. WE use advanced filtering with copy to option to move all line items which contain quantities >0 to a specific area within each worksheet. The copy to range (P9:V3000) is identical for each worksheet. I would like to write a vba macro to copy and combine the advance filtered data from each worksheet to a separate worksheet within the workbook named (Equipment List). My challenge has been selecting only the cells that contain data below cells (P9:V9). P9:V9 is a header row, everything below (P10:V3000) is the data I wish to copy.
Below is the code I have used which is specific to one worksheet ("Ansul Equipment") The code works when I have more than one line item below (P9:V9). When I have only one item code line
"Range(Selection, Selection.End(xlDown)).Select" selects every cell below P10:V10 even though they contain no data. What is the best way to select only the cells in range (P10:V3000) that contain data? Would like to loop through each worksheet if possible.
Sub PC_CombinedCopyTo_EquipmentList()
'Turn Off Screen Updating
Application.ScreenUpdating = False
'Clear the("Equipment List") Copy to Range via macro
Application.Run ("EquipmentList_ClearCTR")
'Set imax rows variable which will allow me to select the first blank cells below the header in the ("Equipment List") worksheet
Sheets("Equipment List").Select
iMaxRows = Cells(Rows.Count, "A").End(xlUp).Row**
'Copy Ansul ADF Equipment list
Sheets("Ansul Equipment").Select
Range("P10:V10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Equipment List").Select
Range("A" & iMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Application.ScreenUpdating = True
End Sub
Range("P10:V10").Select
Range(Selection, Selection.End(xlDown)).Select
This is normal, you select row 10 and you go xlDown, so the selection goes to the end of the worksheet.
Although I advice to avoid using Select, and to edit any Macro-generated code in order to remove this bad idiom, I suggest this as a quick fix:
Range("P10:V" & cells(Rows.count, "v").end(xlUp).Row).Select

VBA query: using clipboard data to filter

I'm using multiple worksheets in Excel to create a database of candidates undergoing some technical training. Each time a candidate is added to the 'database' they are assigned a unique number, for example "2015-0001". When they call to pay their deposit, I'm using a data input table for the telephone operator to note down the details, and it looks up the unique number for the candidate. I then want to filter the main database for the candidate by their number and paste in the confirmed details of the deposit.
My query is this: how do I write the code that copies the candidate number data from the cell on worksheet 1 and then uses that data (irrespective of its value) to filter worksheet 2?
I'm new to macros and have been using "record macro" to generate code which I then edit and learn as I go. So, apologies if this looks extremely clunky. Using record, the filter command simply takes the example text I'm using (in this case 2015-0011), not replacing it with the revised value when the Deposit input table is changed and the macro is run. Am I right to think that I need to use a String?
Thanks in advance. RLC
Sub Confirm_Deposit()
'
' Confirm_Deposit Macro
'
'
Sheets("Take Deposit").Select
Range("C5").Select
Selection.Copy
Sheets("CIP Candidates").Select
ActiveSheet.Range("$A$6:$AK$2507").AutoFilter Field:=1, Criteria1:= _
"2015-0011" <---------------- ISSUE
Sheets("Take Deposit").Select
Range("C6:C8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CIP Candidates").Select
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(0, 20).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.Run _
"'CIP Spreadsheet RLC (with Macros).xlsm'!ThisWorkbook.Clear_Filters"
etc.
This is a different approach that is less "Macro" based and more just simple cell manipulation using loops. It's very flexible. See what you think of the idea, then we can modify to your specific needs.
The part of this code that I would change immediately is selecting where the lookup value comes from. In this example, since I don't know your specifics, I saw you are using "C5" in the example above.
Sub Confirm_Deposit()
Dim source As String
Dim target As String
Dim lookupVal As String
Dim row As Long
Dim searchRow As Long
source = "Take Deposit" 'In case you have similar projects, you can just replace these lines.
target = "CIP Candidates"
lastSourceRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).row
lastTargetRow = Sheets(target).Range("A" & Rows.Count).End(xlUp).row
lastTargetCol = Sheets(target).Cells(1, Columns.Count).End(xlToLeft).Column
lookupVal = TextBox1.Text 'Set the lookupVal from whatever source you choose. I like ComboBoxes when I can.
For searchRow = 2 To lastSourceRow
If Sheets(source).Cells(searchRow, 3).Text = lookupVal Then 'Searching through Source Sheet on Col "C"
Exit For
End If
Next searchRow
'This way, at the end of the search, you have the row number of the original source to be copied, instead of hard coding.
For row = 6 To lastTargetRow 'Loop through the Target Sheet
If Sheets(target).Cells(row, 3).Text = lookupVal Then 'Compare lookupVal to the Range being looped.
For col = 2 To lastTargetCol
Sheets(target).Cells(row, 3) = Sheets(source).Cells(searchRow, col) 'Copies contents from Row 5 of source sheet.
Next col
End If
Next row
End Sub
EDIT: Made lookup Row dynamic instead of hard coded to row 5
Been a while but will this do the trick?
ActiveSheet.Range("$A$6:$AK$2507").AutoFilter Field:=1, Criteria1:= _
Sheets("Take Deposit").Cells(5,3).Value
or
ActiveSheet.Range("$A$6:$AK$2507").AutoFilter Field:=1, Criteria1:= _
Sheets("Take Deposit").Range("C5").Value
theres no need to select and copy the value. You can just reference the Cells Value.

VBA code in Excel to add a row to multiple sheets and then copy formula from adjacent row

I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub