I'm currently trying to use .Find to search for an array of items starting with "K". If there is a match then proceed to filter and delete the item. However, I'm not sure if .Find is able to incorporate the array into its condition. I've considered using For each and If, but the code would be considerably long. Anyone can help or give suggestion for a different method?
Dim ckFOH As Range
Dim Krange As Variant
Krange = Sheets("Master List").Range("G17:G" & Range("G17").End(xlDown).Row)
With Sheets("FOH")
Set ckFOH = .Columns("Q").Find(What:=Krange, LookIn:=xlValues)
If Not ckFOH Is Nothing Then
.Rows("5").AutoFilter Field:=17, Criteria1:="=K*"
.Range("A6:K" & Range("A6").End(xlDown).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With
Find() method of Range object accepts any data type for its "What" parameter, but if you provide a Range (as per your code) or even a 1D array, it's only its first element being actually searched for
moreover from your description I believe that you want to delete all sheet "FOH" rows that have any of actual "K" values found in "Master List" column Q
so you may want to use AutoFilter() and directly filter column Q on all those values providing an array as Criteria1 parameter and activating its xlFilterValues Operator option
as per following code (further explanations in comments):
Option Explicit
Sub main()
Dim Krange As Variant
With Sheets("Master List") 'reference wanted sheet
Krange = Application.Transpose(.Range("G17", .Range("G17").End(xlDown)).Value) ' store referenced sheet column G values from row 17 down to last consecutive not empty cell - explicitly qualify ALL range references to referenced worksheet
End With
With Sheets("FOH") 'reference wanted sheet
With .Range("Q5", .Cells(.Rows.Count, "Q").End(xlUp)) 'reference its column Q range from row 5 (header) to last not empty row
.AutoFilter field:=1, Criteria1:=Krange, Operator:=xlFilterValues ' filtere referenec range on all 'Krange' array values
If CBool(Application.Subtotal(103, .Cells)) > 1 Then .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' if any filtered cells other then header, thene delete their entire rows
End With
.AutoFilterMode = False
End With
End Sub
Related
I have three sheets called: "Dane magazyn", "Sheet3" and "Dostawcy".
What I want my Excel to do is:
1) filter out #N/A values in col. J on sheet "Dane magazyn". All values that should stay after filtering are stored in Col. E on sheet "Dostawcy" - 21 entries, but it will be more in the future.
2) select data that remained after filtering and copy to "Sheet3"
Here's my code so far:
Sub filtruj()
Dim i As Long, arr As Variant, LastRow As Long
Sheets("Dostawcy").Select
With ActiveSheet
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
arr = Sheets("Dostawcy").Range("E2:E" & LastRow).Value
Sheets("Dane magazyn").Select
With ActiveSheet
**.Columns("J").AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues** <---- here I get error
End With
Rest of code...
Error message I get is:
"Run-time error '1004':
AutoFilter method of Range class failed"
websites I've checked (not all listed)
Using string array as criteria in VBA autofilter
VBA assign a range to an Array from different sheet
Fastest way to read a column of numbers into an array
Thanks in advance
Here is working code:
Dim rng, rngToFilter As Range
Dim i As Integer: i = 1
'set you range to area with values to compare against
'if you can, specify here exact range instead of whole column, it can increase efficiency
Set rng = Sheets("Dostawcy").Range("E:E")
'set range to be filtered out, don't specify here whole column,
'in following loop it can result in overflow error
Set rngToFilter = Sheets("Dane magazyn").Range("J1:J100")
'here we will iterate through all cells within the searched range,
'for every cell we will try to find it's value within the other range,
'if it succeeds, so it's not Nothing, then we copy it to Sheet3
For Each cell In rngToFilter
'if any cell causes the error, we will skip one iteration
On Error GoTo ErrorHandler:
If Not rng.Find(cell.Value) Is Nothing Then
Sheets("Sheet3").Cells(i, 1).Value = cell.Value
i = i + 1
End If
ErrorHandler:
Next cell
Don't use Select unless you must, it reduces efficiency of a program.
I have two columns of dates up to 30k lines. I want to filter for one date in the second column and return all the unique dates from the first column.
I could build this in Access but I don't use Access for anything else so it seems overkill to use that. And partly because I am curious if I can do it in Excel.
I'd prefer not to use a loop because it will be expensive in terms of time to run and I am just learning about arrays and class modules so this is a great example.
There is some background on this already on SOF but it's not detailed enough for me - I'm unfamiliar with Class Modules
Filtering 2D Arrays in Excel VBA
Any help or pointers would be greatly appreciated.
Sub CreateUniqueTradeDatesForAsOfDate_test()
Dim InternalArray As Variant
Dim Rg_Internal As Range
Dim arr As New Collection
Dim myRow As Long
Dim myCol As Long
Set d = CreateObject("Scripting.Dictionary")
'set the range
Set Rg_Internal = Worksheets("Bloomberg").Range("G:H")
'Set the array to the range
InternalArray = Rg_Internal.Value
'Transpose the array
InternalArray = Application.Transpose(InternalArray)
'Create the unique
With CreateObject("scripting.dictionary")
For Each it In InternalArray
d = .Item(it)
Next
d = .Keys ' the array .keys contains all unique keys
End With
'print to the immediate window but all unique values of the array
' not just the unique values from the first column based on
'the criteria from the second column
For Each i In d 'To UBound(10, 1)
Debug.Print i; RowNos
Next i
End Sub
I have a table of monthly sales figures - FreqData1. Each column represents a month and is numbered 1 to 12. The user chooses one of these numbers from a dropdown list.
I have the code to find the column number and I have tried to assign the data in that column to an array so I can use it copy it to a different spreadsheet but with my basic VBA knowledge and despite lots of searching I have been unable to find the code as to how to do this or a different method to carry this out.
Can anyone help please
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Worksheets("Freq data").Activate
TPNoInt = Range("B42").Value
BranchNoInt = Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
CharaArray = Range("FreqData1").Cells (1, ColNo), Cells(16, ColNo))
End Sub
Many thanks in advance
I think this is your answer: It's how you're using the range.
Delete your CharArray = ... line and replace with:
With Range("FreqData1")
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
The issue is how you're setting the range, Range().Cells(), Cells() isn't the context, you'd want something more like Range(Cells(),Cells()).
Let's say "FreqData1" is the range A10:A20. If you use
With Range("FreqData1")
.Cells(1,1).Select
End With
this will select the top left most cell (row 1, column 1) in the range "FreqData", so cell A10 would be selected.
A final misc. point: Avoid using .Select/.Activate. You can activate a sheet of course so you can follow your macro, but when setting variables to ranges/cell values, etc. it's best to qualify which sheet you are referring to.
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Dim freqWS As Worksheet
Set freqWS = Worksheets("Freq data")
' Worksheets("Freq data").Activate ' removed this, since we have a variable for it now.
TPNoInt = freqWS.Range("B42").Value ' see how I added the worksheet that we want to get B42's value from?
BranchNoInt = freqWS.Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
With freqWS.Range("FreqData1") ' I'm assuming "FreqData1" is on this worksheet
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
End Sub
I'm not positive if you have to qualify a named range's sheet, since it's a named range, but I added that just to be safe.
Edit2: Hm, oddly enough, if your named range "myRange" is A1:A10, you can still do myRange.Range(myRange.cells(1,1),myRange.cells(1,2)), even though there's no second column in the range, it just expands it. I thought it'd throw an error, but nope. Just to note.
I need to add a section within an existing macro that takes a cell's address and looks for that address (as a string?) from the values within a range of cells elsewhere on the sheet - then offsets one column over to use that cell's value to replace the original value of the cell who's address was searched.
My code is looking for unmerged cells, and when it finds an unmerged cell, it needs to grab the correct value to put in there. Not all cells in my range mCell are unmerged, so this is a find/replace within a loop.
I cannot hard code the cells, and also cannot figure out a functional loop that successfully moves through my range and finds/replaces using values from another part of the worksheet. I'm new at VBA and keep getting errors and wind up defining a dozen ranges and strings trying to carry over the data. Any help would be greatly appreciated!
For example:
if unmerged mCell.address = "B20", then the macro finds the value "B20" in a designated range (in example below, was found in cell Q20), then offset one column over (to cell R20), then uses value of that cell (which is 6) to replace the value of mcell, such that the new cell value of B20 (i.e., the active mCell) = 6. Then on to the next unmerged mCell...
row Column Q Col. R '(not code, but can't get formatting any other way)
18 B18(text) 5
19 B19 4
20 B20 6
21 B21 3
Thank you for any suggestions, My existing code works great until "Part II", but then I'm failing miserably and am requesting specific help on how to correct/improve the code. Existing code is:
' This sub looks for the word "Table" in column A. If the word appears, it unmerges the cells in columns B - E
' and the rows following to allow for the insert of a table, then merges all other rows for sake of format.
Option Explicit
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("B14:E64").SpecialCells(xlCellTypeVisible).Select
With Selection
.RowHeight = 17
.VerticalAlignment = xlTop
.HorizontalAlignment = xlLeft
.WrapText = True
End With
'*******Merge or unmerge rows according to whether or not they contain Table data -
' this only acts on visible cells, so rows of data table can be hidden as needed
Dim TA As Integer
Dim ColValues As Variant
Dim rng As Range
Dim tabNo As Range 'uses value on worksheet to know how many rows to unmerge
'*******Dims in finding and replacing unmerged cell values
Dim mergeRange As Range 'Range B16:E64 - where my mCells are being pulled from
Dim mCell As Range 'Cell that is unmerged, looking for its address
Dim ws As Worksheet
Dim tabledata As Range 'Range Q11:Q38 - this is the column I'm searching in and offsetting from
Dim aCell As String 'picks up cell address, to use in .find
Dim myCell As Range 'cell address in Q
Dim ReplaceString As String
Dim foundCell As Range
Dim bCell As Range
Dim i As Long
Application.DisplayAlerts = False
'Make column B = Column A values, cannot make this happen on sheet, because data is too variable
ColValues = ActiveSheet.Range("A16:A64").Value
ActiveSheet.Range("B16:B64").Value = ColValues
'Look for data table, if not present, merge cells
Set rng = ActiveSheet.Range("B14:B100")
Set tabNo = ActiveSheet.Range("K6")
For TA = 15 To 64 'defines TA variable to loop from row 14 to row 64
If Cells(TA, "A") = "Table" Then '
Range("B" & TA & ":E" & TA + tabNo).UnMerge 'unmerges the row with "Table" listed and the next 7 rows (to make a 8-row x 4 column unmerged area for table
TA = TA + tabNo ' moves active cell "TA" down 7 spaces
Else
Range("B" & TA & ":E" & TA).Merge 'If "Table" not found, then merge the cells for the row TA is in across columns B:E
End If
Next TA
'*** Part II: Need some calculation to loop or offset or find through data and fill
'unmerged cells from a data table on the worksheet.
'the placement of the data table varies depending on the layout of the report,
'which changes day to day, so can not be hard coded into the cells - needs to look up
'position of the word "Table" and dump data after that.
'offset? .find? loop?
'***want to take the cell address of each unmerged cell within the range of the report
'and look for that cell in an array, then replace the cell contents with the correct value
Set mergeRange = ActiveSheet.Range("B16:E64")
For Each mCell In mergeRange
' If mergeRange.MergeCells = True Then
' MsgBox "all cells are merged, exiting sub"
' Exit Sub
'Else
If mCell.MergeCells = False Then
aCell = mCell.Address '??? Need to set the cell address as
'a text string or something in order to look for that address in the values
'of cells in range "tabledata"
'MsgBox "aCell " & Range(aCell).Address
Set tabledata = ActiveSheet.Range("Q11:Q38")
Set bCell = tabledata.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'this gives me a "type mismatch" error that I cannot clear
'- then wanting the value of the cell offset one column over
'need to take the value of that offset cell and use it
'to replace the value of the original unmerged cell (mCell)
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1).Value = ActiveCell.Value
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Next mCell
End Sub
There were a few problems in there but I think it's working now. You'll have to verify as I'm still not 100% sure what it is supposed to do.
Problem 1: You don't need tabledata. You specify in the search parameters After:=Range("Q1") so it's looking in the right place. Find works on a Cells so your line should be:
Set bCell = Cells.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Problem 2: Your line aCell = mCell.Address needs to be aCell = Replace(mCell.Address, "$", "") as it comes in as an absolute cell reference and the cell address on your sheet are not (probably a more elegant way of doing this).
There were a couple of other problems in your Dropbox file but those should be sorted too now. There was an extra Next and the line aCell.Offset(, 1) = bCell.Offset(, 1) seems like it should be mCell.Offset(, 1) = bCell.Offset(, 1).
https://www.dropbox.com/s/jqdg3v0gd59mxjn/Test%20Workbook%201016jb.xlsm
I have a list of customers from last year (in column A) and I have a list of customers from this year (in Column B). I've put the data from these two columns in arrays (using the code below - which is set up as Option Base 1):
'Define our variables and array types'
Sub CustomerArray()
Dim LastArray() As String
Dim CurrentArray() As String
Dim BothArray() As String
Dim LR As Long
Dim i As Integer
'Define LastArray which is customers last year'
LR = Cells(Rows.Count, 1).End(xlUp).Row
ReDim LastArray(LR - 3)
With Range("A1")
For i = 1 To LR - 3
LastArray(i) = .Offset(i, 0)
Next i
End With
'Define CurrentArray which is customers this year'
ReDim CurrentArray(LR - 3)
With Range("B1")
For i = 1 To LR - 3
CurrentArray(i) = .Offset(i, 0)
Next i
End With
End Sub
Now I want to compare/combine the Arrays to show a list of customers who appear in both of the two arrays I just defined (last year and this year). I want to create a third array with the customers who appear for both years (and I want to put that in column D of my excel sheet). I'm getting confused on how to write the code which will compare these two arrays (current year and last year). Will I use a conditional If > statement? Each of the arrays have the customers listed alphabetically.
I appreicate any help you might be able to give me.
Thanks!
You don't need to mess with arrays or loop at all, keep it simple, try something like this:
Sub HTH()
With Range("A1", Cells(Rows.Count, "A").End(xlUp)).Offset(, 3)
.Formula = "=IF(COUNTIF(B:B,A1)>0,A1,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).Delete
End With
End Sub
OK. I got a little carried away here, but this does what your are asking (you may have to tune it up to suit your specific needs. To use this code, simply call the Sub "Match Customers".
Your original code proposed the use of three arrays. Excel VBA provides some mechanisms to do what you seek which are both easier to use, and possibly more efficient.
I went ahead and broke the process out into more discrete chunks of code. While it seems like more code, you will find that each peice might make more sense, and it is much more maintainable. You can also now re-use the individual functions for other operations if needed.
I also pulled your range and column indexes out into locally defined constants. This way, if the various row or column references ever need to change, you only have to change the value in one place.
It is not necessarily the most efficient way to do this, but is most likely less complicated than using the arrays you originally propose.
I have not tested this exhaustively, but it works in the most basic sense. Let me know if you have questions.
Hope that helps . . .
Option Explicit
'Set your Column indexes as constants, and use the constants in your code.
'This will be much more maintainable in the long run:
Private Const LY_CUSTOMER_COLUMN As Integer = 1
Private Const CY_CUSTOMER_COLUMN As Integer = 2
Private Const MATCHED_CUSTOMER_COLUMN As Integer = 4
Private Const OUTPUT_TARGET As String = "D1"
Private Const LAST_ROW_OFFSET As Integer = -3
'A Function which returns the list of customers from last year
'as a Range object:
Function CustomersLastYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, LY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing last year's customers:
Set CustomersLastYear = Range(Cells(1, LY_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which returns the list of customers from this year
'as a Range object:
Function CustomersThisYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, CY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing this year's customers:
Set CustomersThisYear = Range(Cells(1, CY_CUSTOMER_COLUMN), LastCell)
End Function
'A function which returns a range object representing the
'current list of matched customers (Mostly so you can clear it
'before re-populating it with a new set of matches):
Function CurrentMatchedCustomersRange() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, MATCHED_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing currently matched customers:
Set CurrentMatchedCustomersRange = Range(Cells(1, MATCHED_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which performs a comparison between two ranges
'and returns a Collection containing the matching cells:
Function MatchedCustomers(ByVal LastYearCustomers As Range, ByVal ThisYearCustomers As Range) As Collection
Dim output As Collection
'A variable to iterate over a collection of cell ranges:
Dim CustomerCell As Range
'Initialize the collection object:
Set output = New Collection
'Iterate over the collection of cells containing last year's customers:
For Each CustomerCell In LastYearCustomers.Cells
Dim MatchedCustomer As Range
'Set the variable to reference the current cell object:
Set MatchedCustomer = ThisYearCustomers.Find(CustomerCell.Text)
'Test for a Match:
If Not MatchedCustomer Is Nothing Then
'If found, add to the output collection:
output.Add MatchedCustomer
End If
'Kill the iterator variable for the next iteration:
Set MatchedCustomer = Nothing
Next
'Return a collection of the matches found:
Set MatchedCustomers = output
End Function
Sub MatchCustomers()
Dim LastYearCustomers As Range
Dim ThisYearCustomers As Range
Dim MatchedCustomers As Collection
Dim MatchedCustomer As Range
'Clear out the destination column using the local function:
Set MatchedCustomer = Me.CurrentMatchedCustomersRange
MatchedCustomer.Clear
Set MatchedCustomer = Nothing
'Use local functions to retrieve ranges:
Set LastYearCustomers = Me.CustomersLastYear
Set ThisYearCustomers = Me.CustomersThisYear
'Use local function to preform the matching operation and return a collection
'of cell ranges representing matched customers. Pass the ranges of last year and this year
'customers in as Arguments:
Set MatchedCustomers = Me.MatchedCustomers(LastYearCustomers, ThisYearCustomers)
Dim Destination As Range
'Use the local constant to set the initial output target cell:
Set Destination = Range(OUTPUT_TARGET)
'Itereate over the collection and paste the matches into the output cell:
For Each MatchedCustomer In MatchedCustomers
MatchedCustomer.Copy Destination
'Increment the output row index after each paste operation:
Set Destination = Destination.Offset(1)
Next
End Sub
If you want to compare the two arrays using loops, maybe because you have, for example, picked up all the data into arrays for faster computation rather than interacting with the spreadsheet range object, or you need to compare multiple things from the two arrays to check that the entries match so can't use a .find statement, then this is what you need:
-Two loops, one nested inside the other
-Three counters, one for each array
-One "Exit Loop", "Exit For", "GoTo foundmatch" or similar way of exiting the inner loop
-A "Redim Preserve" of the results array
-An "If" statement
-Finally, one line where you assign the name that appears in both arrays to the results array
This is everything that is needed to write it simply as loops - but doesn't give the fastest or best way to do it (Redim Preserve is not the best..). Constructing it should be easy from this list though: the if statement should either be an x=y type for a general usage, or if x>y if you are really really sure that the list being looped in the inner loop really is sorted alphabetically