VBA query: using clipboard data to filter - vba

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.

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

Concat tables in different excel worksheet

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

How to check the sign of a cell and then copy and paste it to another sheet?

I have a column of numbers and want to go through each cell to check if the number is positive, or negative. After determining if a number is positive, or negative I want to copy and paste that number into a new table on a new sheet separating the positive and negative values.
I used a nested if statement to do this originally but instead of getting a list of 20 positive numbers, and 20 negative numbers from my total of 40 numbers I got a list of 20 positive numbers with 20 false conditions in my new positive only table (same thing with the negative).
I would like to pull the positive and negative values without duplicating them, or getting the false condition of the if statement in my new table.
The last thing I have been trying to implement is having this code search through my column of numbers instead of a fixed range so in the future I can add numbers and the new positive/negative tables will automatically generate the additional numbers.
I am fairly new to VBA and coding in general so any help is much appreciated.
Thanks,
Olek!
My code pretty much follows the Macro code:
Sub Variance()
'
' Variance Macro
'
'
Range("F2:F60").Select
Selection.Copy
Sheets("Macro").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:A60").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.AutoFilter
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:=">=0", _
Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-12
Range("A3:A60").Select
Selection.Copy
Sheets("Bullseye").Select
Range("AH3").Select
ActiveSheet.Paste
Columns("AH:AH").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=-18
Sheets("Macro").Select
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:="<0", _
Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-21
Range("A2:A59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bullseye").Select
Range("AK3").Select
ActiveSheet.Paste
End Sub
This code gets the job done but I wanted to change it so that I could have code run that will auto generate all my data in the same way but without having a fixed range. Additionally, I have to delete all the data that this macro fills if I want to run it again.
Basically just trying to cut down the number of steps so that this sheet is fully automated as much as possible.
Thanks!
You can try using a variable. In this case, the variable RowNum finds row number for the last value in column F. You can then substitute the variable RowNum for the number 60 in each place in your code, making your ranges dynamic like this:
Dim RowNum As Integer
RowNum = Sheets("Macro").Cells(Rows.Count, "F").End(xlUp).Row
Range("F2:F" & RowNum).Select
'...
Range("A2:A" & RowNum).Select
you have to avoid all Select/Selection/Activate/ActiveXXX pattern design which is 99,99% unnecessary and switch to fully qualified range references
furthermore you don't need any "intermediate" sheet as your "macro" since you can filter data directly in place
Option Explicit
Sub Variance()
With Worksheets("numbersSheet") '<--| reference your data worksheet (change "numbersSheet" to your actual sheet with numbers name)
With Range("F1", .Cells(.Rows.count, "F").End(xlUp)) '<--| reference its column "F" range from row 1 (header) down to last not empty row
FilterAndWrite .Cells, ">=0", Worksheets("Bullseye").Range("AH3") '<--| filter positive or zero values and write them from Worksheets("Bullseye").Range("AH3") downwards
FilterAndWrite .Cells, "<0", Worksheets("Bullseye").Range("AK3") '<--| filter negative values and write them from Worksheets("Bullseye").Range("AK3") downwards
End With
.AutoFilterMode = False
End With
End Sub
Sub FilterAndWrite(sourceRng As Range, criterium As String, targetRng As Range)
With sourceRng
.AutoFilter Field:=1, Criteria1:=criterium
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cells other than header
.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy '<--| copy filtered cell skipping header
targetRng.PasteSpecial xlPasteValues '<--| paste values in passed target range
End If
End With
End Sub

Trying to copy a formula down an entire column to the last row of data in an adjacent column

I am a new VBA user, and I am trying to create a VBA code to copy a single Vlookup formula down an entire column to the last row of data in an adjacent column. I don't want to specify a specific range, because I intend to use this macro with multiple different files that have different row ranges, so I am looking for a code that will simply copy down to the last value in an adjacent column.
I have tried looking at other similar questions and answers on this website, but none of the solutions that I have found have been working, and I would really appreciate some help!
Here is my code that I currently have:
' Section5 Macro
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[6],'[PERSONAL.XLSB]Task and Sections'!R2C1:R254C2,2,FALSE)"
Range("C2").Select
Selection.Copy 'Copy Vlookup Formula
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C3").AutoFill destination:=Range("C3:C" & lastRow) 'Specify range for Column C based off of row count in Column B
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Paste Vlookup equation down the column
End Sub
The formula I want to copy is "=VLOOKUP(RC[6],'[PERSONAL.XLSB]Task and Sections'!R2C1:R254C2,2,FALSE". The column that I want to copy this formula down is column C (in all rows except C1 which is the Header). The column that I want to refer to for row length is the adjacent column B.
Currently I am getting an error that says "Compile error: Named argument not found".
Any help would be greatly appreciated!
Thank you,
As pointed in the comment, you had a simple typo ("desination")... Nevertheless, your code doesn't seem to work even when this is fixed.
There's a much simpler approach. Try this:
Sub FillWithFormula()
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C2:C" & lastRow).FormulaLocal = "=B2*2"
End Sub
Notice that I replaced your formula with a simpler one (independent of external data) so I could verify that the routine works.
Here.
Sub thing()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("C3:C" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[6],'[PERSONAL.XLSB]Task and Sections'!R2C1:R254C2,2,FALSE)"
Range("C3:C" & lastRow).Value = Range("C3:C" & lastRow).Value
End Sub
Simpler, more elegant. Hasn't this kind of thing been solved like a million times all around the internet? Anyway, copy-paste is the slowest thing you can do in a macro. Avoid it. Just set the values of a range to be the values of the range. :)
Also, you can assign a formula to a whole range.

Loops with advanced filter, new criteria every Loop

I have this code:
Sub omgifthisworks()
Sheets("data").Select
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("log").Range("A1:A4"), Unique:=False
Sheets("Data").Select
Sheets("Data").Copy After:=Sheets(3)
ActiveSheet.Name = Sheets("banks").Range("A2").Value
enter code here
It's function is pretty basic. Is it possible to create a Loop where this code will create as many new worksheets as I have cells in column "A" in my "banks" worksheet?
Is it also possible to have the loop move the filter criteria on column to the right and select only as many cells as there is data?
The end result that I'm hoping to achieve is code that will create many new sheets of data with different names that have data inside which is filtered by new criteria every time.
For your first question about looping through, go here:
http://www.excel-easy.com/vba/loop.html
http://msdn.microsoft.com/en-us/library/eked04a7.aspx
For your second:
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = [name you want]
I've used code like this to do something similar what you're talking about.
origSh as the Worksheet containing the original data to filter.
filterSh is a Worksheet containing the data for the Advanced Filter. Row 1 contains column headers to filter on; row 2 contains the data criteria to filter.
The procedure loops through the columns of filterSh and filters the data in origSh by the given criteria, copying the filtered data to new sheets placed at the end of the workbook.
Sub FilterToSheets(origSh As Worksheet, filterSh As Worksheet)
Dim filterRng As Range
Dim newSh As Worksheet
Set newSh = filterSh
For Each filterRng In filterSh.UsedRange.Columns
Set newSh = ActiveWorkbook.Worksheets.Add(after:=newSh)
newSh.Name = filterRng.Cells(2).Text
origSh.UsedRange.AdvancedFilter _
Action:=xlFilterCopy, _
criteriarange:=filterRng, _
copytorange:=newSh.Range("A1"), _
unique:=False
Next
End Sub
This should hopefully give you a leg up to write something that fits your example.