I need to populate specific columns in one tab from the original data held in the first tab. I have done a quick reordered VBA code to help anybody understand what I am trying to do in the hope they can refine. I also need the VBA code to stop at the line where the data ends. currently the recorded VBA code pulls down to row 159 yet the data in the original tab stops at row 72. I would have stopped my VBA code at the line where the information ends but this changes from day to day and could be anywhere from row 1 to 158.
(If I populate a cell past where the data ends in the original it makes the sheet unusable for other purposes I require it for, even if it is a zero.)
There is data in column A and B, so I was thinking if the macro could say if data is in cell A15 then pull though info from G15 etc?? No data no pull.
I know this may seem basic to some but as a novice I am still getting my head around VBA.
Sub Populate_Order()
ActiveWindow.SmallScroll Down:=-15
Range("M8").Select
ActiveCell.FormulaR1C1 = "='Order Sheet'!R[7]C[-6]"
Range("M8").Select
Selection.AutoFill Destination:=Range("M8:M159"), Type:=xlFillDefault
Range("M8:M159").Select
ActiveWindow.SmallScroll Down:=-135
Range("Q8").Select
ActiveCell.FormulaR1C1 = "='Order Sheet'!R[7]C[-9]"
Range("Q8").Select
Selection.AutoFill Destination:=Range("Q8:Q159"), Type:=xlFillDefault
Range("Q8:Q159").Select
ActiveWindow.SmallScroll Down:=-132
Range("R8").Select
ActiveCell.FormulaR1C1 = "='Order Sheet'!R[7]C[-9]"
Range("R8").Select
Selection.AutoFill Destination:=Range("R8:R159"), Type:=xlFillDefault
Range("R8:R159").Select
ActiveWindow.SmallScroll Down:=-123
Range("I3").Select
to find the next empty row try something like this
Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("sheet1")
Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("sheet2")
lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
destSheet.range("A" & lMaxRows + 1).Value = sourceSheet.range("M1").Value
this is a simple example of finding the next empty row then setting column A in that row to the value from cell M1 in another sheet
Related
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
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
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
I am trying to make a macro that will run a vlookup and then autofill down to the last adjacent cell that contains data. When I originally created the macro the dataset contained 1917 lines of data which is why you will continue to see it reference 1917. However, the dataset varies in size daily.
This particular macro takes a couple of steps before getting to this point:
Converts text to columns
Deletes an unnecessary column that is provided from a supporting report
Adds titles to 5 columns
Resizes all of the columns to fix the data
Then it runs the first vlookup which I need the data to fill down to the last adjacent cell to the left
Then it runs another vlookup which I need to also fill down to the last adjacent cell to the left
Here is the code for the two vlookup I am struggling with:
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-4],'CURRENT DAY'!R[-1]C[-4]:R[2498]C[1],5,0)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'CURRENT DAY'!R1C1:R2500C6,5,0)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E1917")
Range("E2:E1917").Select
Columns("E:E").EntireColumn.AutoFit
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-5],'CURRENT DAY'!R[-1]C[-5]:R[2498]C,6,0)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],'CURRENT DAY'!R1C1:R2500C6,6,0)"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F1917")
Range("F2:F1917").Select
There is not need to autofill. Just find the last row in column A and use that to denote the range in which to put the r1c1 formula
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
Range("E2:E" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-4],'CURRENT DAY'!R1C1:R2500C6,5,0)"
Range("F2:F" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-5],'CURRENT DAY'!R1C1:R2500C6,6,0)"
Columns("E:F").EntireColumn.AutoFit
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