Looping through filter criteria for a column and performing analysis on visible data to copy to new sheet - VBA Macro - vba

Effectively what I am trying to accomplish is to filter a database (all in Sheet 1) by names, which are given in column A, and then perform various data analysis on the now filtered visible data, and then copy that data to a new sheet in a given cell.
For example, filter the data in Sheet 1 by the name 'Smith' in column A and then let's say sum all of the visible data in column B and print that to cell C3 on Sheet 2. The more advanced data analysis I am sure I can tackle on my own, just want to get rolling here and I am definitely new to VBA macro coding. I have created all of these databases using Python.
The last piece of this, would be being able to loop through all of the filter criteria in column A (which I will not know before-hand and may be anywhere from 10-20 names.
Here is the code I am working with (there are likely some syntax errors in here as well):
Option Explicit
Sub Data()
Dim playername As String
Dim team As String
Dim numFilters As Integer
Dim hits As Integer
Dim src As Worksheet
Dim tgt As Worksheet
Dim filterRange As Range
Dim copyRange As Range
Dim lastRow As Long
Dim i As Integer
team = ThisWorkbook.Sheets(1).Name
numFilters = ActiveSheet.AutoFilter.Filters.Count ' I want this to capture the num of filter criteria for column A
For i = 1 To numFilters
playername = Sheets(team).Filter(i) ' This would be the filter criteria for the given iteration
ActiveSheet.Range("$A$1:$AN$5000").AutoFilter field:=1, Criteria1:=playername
' Create new sheet with name of person
Sheets.Add After:=ActiveSheet
ActiveSheet.Select
ActiveSheet.Name = playername
Set tgt = ThisWorkbook.Sheets(i + 1)
' Perform data analysis (e.g. sum column B of filtered data)
src.AutoFilterMode = False
' Find the last row with data in column A
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
' The range that we are auto-filtering (all columns)
Set filterRange = src.Range("A1:AN" & lastRow)
' Set the range to start in row 2 to prevent copying the header
Set copyRange = src.Range("B2:B" & lastRow)
' Copy the sum of column B to our target cell on the sheet corresponding to this iteration
Application.WorksheetFunction.Sum(copyRange.SpecialCells(xlCellTypeVisible)).Copy tgt.Range("A1")
Next i
End Sub
This is currently failing on the Application.WorksheetFunction.Sum line with the error 'Invalid qualifier'. Thanks for any help and please let me know if something needs clarified.

Related

Converting Excel Formula to VBA and use Array

I need to convert the following excel formula to VBA code:
=C10+H:H
UPDATE:
I want to take the values in column H of Worksheet1 and add them to the value in cell C10. I then want to compare that new value to a range of values in column C in Worksheet 2. I have been using the entire column because the rows that use the data in that column fluctuate.
I want to be able to look at the data a decade at a time. So at 10 years I am using Worksheet1!H20:H30. Then at 20 years I would use Worksheet1!H20:H40 and so on.
I could reasonably for VBA purposes limit the range from the entire column to Worksheet1!H20:H1000 (maybe even less, not sure just yet). The data in column H is what I need to put in an array and then need to be able to add to that data (will probably need to store result in second array) and then compare the result to an additional grouping of data on a separate worksheet (i.e. Worksheet2!C:C).
I need to calculate age based on annual incremental increases. I have my starting age stored in C10. I have the annual increments stored in column H. The way it works in excel is if I have this in cell B22 it add C10 to H22.
This formula is wrapped in a long and daunting if statement. It compares the calculated age to an age range on a different worksheet in lets say column C (i.e. Worksheet2!C:C = C10 + Worksheet1!H:H).
I need to be able to do that in VBA.
I tried in VBA
ElseIf Worsheets("Sheet2").Range("C:C") = C10 + Worsheets("Sheet1").Range("H:H")
It throw a match error.
UPDATE: FOR LOOP IN FUNCTION I TRIED TO USE
Function arrCalc_30yrMax_age_annual_incr_stnd_mbr() As Variant
'SETS THE VARIABLES
Dim wb As Workbook
Dim ws_Calculator_TL_30yrMaxTerm As Worksheet
Dim ws_LVRates As Worksheet
Dim ws_TLRates As Worksheet
Dim ws_Misc As Worksheet
Dim rngCalc_30yrMax_age_mbr As Range
Dim rngCalc_30yrMax_age_sp As Range
Dim rngCalc_30yrMax_age_annual_incr As Range
Dim arrCalc_30yrMax_age_annual_incr As Variant
Dim arrAge_Annual_Inc As Variant
Dim Row As Long
Dim Column As Long
'SETS RANGE FOR rngCalc_30yrMax_age_annual_incr RANGE
Set wb = ThisWorkbook
Set ws_Calculator_TL_30yrMaxTerm = Worksheets("Calculator_TL_30yrMaxTerm")
Set ws_LVRates = wb.Worksheets("LVRates")
Set ws_TLRates = wb.Worksheets("TLRates")
Set ws_Misc = wb.Worksheets("Misc")
Set rngCalc_30yrMax_age_annual_incr = ws_Calculator_TL_30yrMaxTerm.Range("Calc_30yrMax_age_annual_incr")
'SETS ARRAY EQUAL TO rngCalc_30yrMax_age_annual_incr
arrCalc_30yrMax_age_annual_incr = rngCalc_30yrMax_age_annual_incr
'LOOP THROUGH THE ARRAY OF WORKSHEET VALUES
For Row = 1 To UBound(arrCalc_30yrMax_age_annual_incr, 1) 'First array dimension is rows.
For Column = 1 To UBound(arrCalc_30yrMax_age_annual_incr, 1) 'Secong array dimension is columns.
arrAge_Annual_Inc = arrCalc_30yrMax_age_annual_incr + rngCalc_30yrMax_age_mbr
Next Column
Next Row
End Function
Absent data and desired results, I remain uncertain as to just what you want. Perhaps this approach will help, if my assumptions are correct. If not, I'll delete it.
I think what you are trying to do (based on your ELSEIF statement above)
examine each value in Column C
find the value in Column H that is equal to that value +10
if you find such a value, do something.
if your comparison is more complicated (eg finding an inexact match, and the values in column H are sorted, a different approach should be used)
Here is one way of doing it. (and there are a number of others, in addition to looping through all the data -- exactly which is best (fastest) depends on the circumstances.
Option Explicit
'Worsheets("Sheet2").Range("C:C") = C10 + Worsheets("Sheet1").Range("H:H")
Sub Marine()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Range, r2 As Range
Dim vToFind 'declare as a type of value ?date ?long ?double
Dim c1 As Range, c2 As Range
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
'set ranges to end at the last used cell in the columns
With ws1
Set r1 = .Range(.Cells(1, "C"), .Cells(.Rows.Count, "C").End(xlUp))
End With
With ws2
Set r2 = .Range(.Cells(1, "H"), .Cells(.Rows.Count, "H").End(xlUp))
End With
For Each c1 In r1
vToFind = c1 - Range("c10")
Set c2 = r2.Find(what:=vToFind, after:=r2(1), _
LookIn:=xlValues, searchdirection:=xlNext)
If Not c2 Is Nothing Then
'do your thing
Stop
Else
MsgBox vToFind & " not found in target"
End If
Next c1
End Sub

How do i get autofilter field indicator to indicate the correct column?

I have a spreadsheet w/30 or so columns. My goal is to filter the set based on 1 column and my approach was the specify a range being just that column and then filter that range. I do have autofilters on every column and when i specify a field:=1 excel picks the first column...whcih is outside of my range. So it's always trying to filter on column "A"...not column "U" as desired. Am i mis-understanding how to use this field? i though it was an offset w/in a range.
here's a simple example
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
sheet.Range("u1:u9").AutoFilter field:=1, Criteria1:="Will"
as an aside...is there a way to get a column number associated with the column letter? for example U --> 21. if so i could select the entire spreadsheet as the range and do an offset of 21
If you are applying filters to one column, you will have to clear the existing filters first.
Your tweaked code would be something like this and it will apply the filter to column U only...
Sub test()
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
sheet.AutoFilterMode = False
sheet.Range("u1:u9").AutoFilter field:=1, Criteria1:="Will"
End Sub
OR
You may also apply the filters to all the columns and specify the field criteria correctly.
Give this a try...
Sub test2()
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
Set r = sheet.Range("U1")
sheet.AutoFilterMode = False
sheet.Range("A1").CurrentRegion.AutoFilter field:=r.Column, Criteria1:="Will"
End Sub

Copy/Paste rows to matching named sheet

I have a worksheet "List" which has rows of data that I need to copy to other worksheets. In column "J" of "List", there is a name (Matthew, Mark, Linda, etc.) that designates who's data that row is.
Each of those names (22 in all) has a matching spreadsheet with the same name. I want all rows that say "Linda" in column "J" to paste to worksheet "Linda", all rows with "Matthew" to paste to worksheet "Matthew", etc.
I have some code below, which mostly works, but I'd have to rewrite it for all 22 names/sheets.
Is there a way to loop through all the sheets, pasting the rows with matching names? Also, the code below works really slowly, and I'm using data sets with anywhere from 200 to 60,000 rows that need sorted and pasted, which means that if its slow on a small data set like the one I'm currently working on, and only for one sheet, it's going to be glacially slow for the big data sets.
Sub CopyMatch()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = Worksheets("List")
Set Target = Worksheets("Linda")
j = 4 ' Start copying to row 1 in target sheet
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
If c = "Linda" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
Unless you've turned calculation off somewhere we can't see here, then every time you copy a row, Excel is recalculating - even if your sheets contain no formulas.
If you're not doing so already, simply putting:
application.calculation=xlcalculationmanual
before you start your loop and:
application.calculation=xlcalculationautomatic
after exiting the loop will massively speed up your loop. For extra swank, you can use a variable to store the calculation setting before you turn it off and restore that setting at the end, e.g.
dim lCalc as long
lCalc = application.calculation
application.calculation = xlcalculationmanual
for ... next goes here
application.calculation = lCalc
Also consider other settings, e.g.: application.screenupdating=False|True.
Sort the data by the name you're selecting on, then by any other sorts you want. That way you can skip through any size sheet in 22 steps (since you say you have 22 names).
How you copy the data depends on preference and how much data there is. Copying one row at a time is economical on memory and pretty much guaranteed to work, but is slower. Or you can identify the top and bottom rows of each person's data and copy the whole block as a single range, at the risk of exceeding the memory available on large blocks in large sheets.
Assuming the value in your name column, for the range you're checking, is always one of the 22 names, then if you've sorted first by that column you can use the value in that column to determine the destination, e.g.:
dim sTarget as string
dim rng as range
sTarget = ""
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
if c <> "" then ' skip empty rows
if c <> sTarget then ' new name block
sTarget = c
Set Target = Worksheets(c)
set rng = Target.cells(Target.rows.count, 10).end(xlup) ' 10="J"
j = rng.row + 1 ' first row below last name pasted
end if
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
end if
Next
This is economical of memory because you're going row by row, but still reasonably fast because you're only recalculating Target and resetting j when the name changes.
you could use:
Dictionary object to quickly build the list of unique names out of column J names
AutoFilter() method of Range object for filtering on each name:
as follows
Option Explicit
Sub CopyMatch()
Dim c As Range, namesRng As Range
Dim name As Variant
With Worksheets("List") '<--| reference "List" worskheet
Set namesRng = .Range("J4", .Cells(.Rows.count, "J").End(xlUp)) '<--| set the range of "names" in column "J" starting from row 4 down to last not empty row
End With
With CreateObject("Scripting.Dictionary") '<--| instance a 'Dictionary' object
For Each c In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through "names" range cells with text content only
.item(c.Value) = c.Value '<--| build the unique list of names using dictionary key
Next
Set namesRng = namesRng.Resize(namesRng.Rows.count + 1).Offset(-1) '<--| resize the range of "names" to have a "header" cell (not a name to filter on) in the first row
For Each name In .Keys '<--| loop through dictionary keys, i.e. the unique names list
FilterNameAndCopyToWorksheet namesRng, name '<--| filter on current name and copy to corresponding worksheet
Next
End With '<--| release the 'Dictionary' object
End Sub
Sub FilterNameAndCopyToWorksheet(rangeToFilter As Range, nameToFilter As Variant)
Dim destsht As Worksheet
Set destsht = Worksheets(nameToFilter) '<--| set the worksheet object corresponding to passed name
With rangeToFilter
.AutoFilter Field:=1, Criteria1:=nameToFilter
Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy destsht.Cells(destsht.Rows.count, "J").End(xlUp)
.Parent.AutoFilterMode = False
End With
End Sub

how to create macro because values to be copy in DropDown are increasing always. and I have to give Source to Create List in Data Validation

I want to make drop Down List in sheet2 which contains values from sheet1 column. I have tried this code.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
columns in sheet1 are changing oftenly. so needs to create Dynamic VBA Macro code.
Please guide me for this query.
For your case, I don't think that you need a macro to manage the drop down list but perhaps data validation will do.
Create a new worksheet,
I got a worksheet contain the following data at column A
At the worksheet that i want the dropdownlist, i just highlight the cell and click on the data validation button at data ribbon
In the data validation, create the following setting
Click on the ok button and the list will be created
Since in the columns in the worksheet(source) keep on changing, you need write the macro to copy the entire needed column exclude the header of the column to next worksheet(e.g. worksheet that create the dropdown list).
Edited: Code to detect the criteria column and copy the column
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyWorksheet2 As Worksheet
Dim WantedColumn As Long
Dim ColumnPointer As Long
Sub copyCriteria()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Sheet6")
Set MyWorksheet2 = MyWorkbook.Sheets("Sheet5")
For ColumnPointer = 1 To MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
If MyWorksheet.Cells(1, ColumnPointer).Value = "ColumnE" Then
MyWorksheet.Columns(ColumnPointer).Copy
MyWorksheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
MyWorksheet2.Rows("1:1").Delete Shift:=xlUp
End If
Next
End Sub
What you are trying to do can be done with a simple named range and Data Validation to use that Name. If you have not heard of Dynamic Ranges, then you should read on.
If Sheet1 only has the 1 column for the DropDown list via Data Validation, you should use a Named Range instead of a fixed Range. But this named range is dynamic (by using formula)! See OFFSET usage.
Lets say Sheet1 is like below:
Lets say the name to be used is MyList, then in Excel click Name Manager in Formulas tab, and place in below as the Range Refers to:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))
Now in Sheet2, the Data Validation is placed on B2, when setting it up, once you put in the source to =MyList, Excel highlights it:
Then the drop down list worked:
Now if you add data to your list (Column A on Sheet 1), the MyList automatically expands and hence your DataValidation drop down list!
Note the list will go up to the first blank cell in Column A, so NO GAPS!
Enjoy!

Creating a parameterized query in Excel with SQL using a cell as a parameter

So in MS Excel I've imported a table from a database in a SQL Server. I want to create a parameterized query where you have two cells. Say these two cells are G1 and G2. G1 takes a parameter/category and G2 takes a value from the parameter/category and queries the table you imported (essentially a WHERE clause that is dynamic from cell input). Can someone show me how to do this?
EDIT: Based on a chat session, we discovered that the first parameter is the column to be searched and the second parameter is the value to filter.
You can do what you want by filtering the table you imported.
Use the code below as your template. Modify it to reference the correct worksheets and ranges.
Sub FilterByParameter()
Dim wb As Workbook
Dim dataSheet As Worksheet
Dim parameterSheet As Worksheet
Dim rng As Range
Dim filterColumn As Long
Dim filterValue As String
Set wb = ThisWorkbook
' sheet that contains your table
Set dataSheet = wb.Sheets("Sheet1")
' sheet that contains your parameters
Set parameterSheet = wb.Sheets("Sheet2")
' range that contains your table, hard-coded here
' but can easily be set dynamically
Set rng = dataSheet.Range("A1:F78")
' get the column you are searching
filterColumn = parameterSheet.Range("G1").Value
' get the value you want to filter on
filterValue = parameterSheet.Range("G2").Value
' turn off autofilters if set
dataSheet.AutoFilterMode = False
' autofilter using your column and filter
rng.AutoFilter field:=filterColumn, Criteria1:=filterValue
' now you can do whatever you want to with the rows
' that remain after the autofilter was applied
End Sub
See Efficient way to delete entire row if... for an example of how to use the visible rows.