I have worked in Python earlier where it is really smooth to have a dictionary of lists (i.e. one key corresponds to a list of stuff). I am struggling to achieve the same in vba. Say I have the following data in an excel sheet:
Flanged_connections 6
Flanged_connections 8
Flanged_connections 10
Instrument Pressure
Instrument Temperature
Instrument Bridle
Instrument Others
Piping 1
Piping 2
Piping 3
Now I want to read the data and store it in a dictionary where the keys are Flanged_connections, Instrument and Piping and the values are the corresponding ones in the second column. I want the data to look like this:
'key' 'values':
'Flanged_connections' '[6 8 10]'
'Instrument' '["Pressure" "Temperature" "Bridle" "Others"]'
'Piping' '[1 2 3]'
and then being able to get the list by doing dict.Item("Piping") with the list [1 2 3] as the result. So I started thinking doing something like:
For Each row In inputRange.Rows
If Not equipmentDictionary.Exists(row.Cells(equipmentCol).Text) Then
equipmentDictionary.Add row.Cells(equipmentCol).Text, <INSERT NEW LIST>
Else
equipmentDictionary.Add row.Cells(equipmentCol).Text, <ADD TO EXISTING LIST>
End If
Next
This seems a bit tedious to do. Is there a better approach to this? I tried searching for using arrays in vba and it seems a bit different than java, c++ and python, with stuft like redim preserve and the likes. Is this the only way to work with arrays in vba?
My solution:
Based on #varocarbas' comment I have created a dictionary of collections. This is the easiest way for my mind to comprehend what's going on, though it might not be the most efficient. The other solutions would probably work as well (not tested by me). This is my suggested solution and it provides the correct output:
'/--------------------------------------\'
'| Sets up the dictionary for equipment |'
'\--------------------------------------/'
inputRowMin = 1
inputRowMax = 173
inputColMin = 1
inputColMax = 2
equipmentCol = 1
dimensionCol = 2
Set equipmentDictionary = CreateObject("Scripting.Dictionary")
Set inputSheet = Application.Sheets(inputSheetName)
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection
For i = 1 To inputRange.Height
thisEquipment = inputRange(i, equipmentCol).Text
nextEquipment = inputRange(i + 1, equipmentCol).Text
thisDimension = inputRange(i, dimensionCol).Text
'The Strings are equal - add thisEquipment to collection and continue
If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
equipmentCollection.Add thisDimension
'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
Else
equipmentCollection.Add thisDimension
equipmentDictionary.Add thisEquipment, equipmentCollection
Set equipmentCollection = New Collection
End If
Next
'Check input
Dim tmpCollection As Collection
For Each key In equipmentDictionary.Keys
Debug.Print "--------------" & key & "---------------"
Set tmpCollection = equipmentDictionary.Item(key)
For i = 1 To tmpCollection.Count
Debug.Print tmpCollection.Item(i)
Next
Next
Note that this solution assumes that all the equipment are sorted!
Arrays in VBA are more or less like everywhere else with various peculiarities:
Redimensioning an array is possible (although not required).
Most of the array properties (e.g., Sheets array in a Workbook) are 1-based. Although, as rightly pointed out by #TimWilliams, the user-defined arrays are actually 0-based. The array below defines a string array with a length of 11 (10 indicates the upper position).
Other than that and the peculiarities regarding notations, you shouldn't find any problem to deal with VBA arrays.
Dim stringArray(10) As String
stringArray(1) = "first val"
stringArray(2) = "second val"
'etc.
Regarding what you are requesting, you can create a dictionary in VBA and include a list on it (or the VBA equivalent: Collection), here you have a sample code:
Set dict = CreateObject("Scripting.Dictionary")
Set coll = New Collection
coll.Add ("coll1")
coll.Add ("coll2")
coll.Add ("coll3")
If Not dict.Exists("dict1") Then
dict.Add "dict1", coll
End If
Dim curVal As String: curVal = dict("dict1")(3) '-> "coll3"
Set dict = Nothing
You can have dictionaries within dictionaries. No need to use arrays or collections unless you have a specific need to.
Sub FillNestedDictionairies()
Dim dcParent As Scripting.Dictionary
Dim dcChild As Scripting.Dictionary
Dim rCell As Range
Dim vaSplit As Variant
Dim vParentKey As Variant, vChildKey As Variant
Set dcParent = New Scripting.Dictionary
'Don't use currentregion if you have adjacent data
For Each rCell In Sheet2.Range("A1").CurrentRegion.Cells
'assume the text is separated by a space
vaSplit = Split(rCell.Value, Space(1))
'If it's already there, set the child to what's there
If dcParent.Exists(vaSplit(0)) Then
Set dcChild = dcParent.Item(vaSplit(0))
Else 'create a new child
Set dcChild = New Scripting.Dictionary
dcParent.Add vaSplit(0), dcChild
End If
'Assumes unique post-space data - text for Exists if that's not the case
dcChild.Add CStr(vaSplit(1)), vaSplit(1)
Next rCell
'Output to prove it works
For Each vParentKey In dcParent.Keys
For Each vChildKey In dcParent.Item(vParentKey).Keys
Debug.Print vParentKey, vChildKey
Next vChildKey
Next vParentKey
End Sub
I am not that familiar with C++ and Python (been a long time) so I can't really speak to the differences with VBA, but I can say that working with Arrays in VBA is not especially complicated.
In my own humble opinion, the best way to work with dynamic arrays in VBA is to Dimension it to a large number, and shrink it when you are done adding elements to it. Indeed, Redim Preserve, where you redimension the array while saving the values, has a HUGE performance cost. You should NEVER use Redim Preserve inside a loop, the execution would be painfully slow
Adapt the following piece of code, given as an example:
Sub CreateArrays()
Dim wS As Worksheet
Set wS = ActiveSheet
Dim Flanged_connections()
ReDim Flanged_connections(WorksheetFunction.CountIf(wS.Columns(1), _
"Flanged_connections"))
For i = 1 To wS.Cells(1, 1).CurrentRegion.Rows.Count Step 1
If UCase(wS.Cells(i, 1).Value) = "FLANGED_CONNECTIONS" Then ' UCASE = Capitalize everything
Flanged_connections(c1) = wS.Cells(i, 2).Value
End If
Next i
End Sub
Related
I have seen multiple codes regarding this topic but I can't seem to understand it.
For instance, if I have a column that records people names, I want to record all unique names into the array.
So if I have a column of names
David
Johnathan
Peter
Peter
Peter
Louis
David
I want to utilize VBA to extract unique names out of the column and place it into an array so when I call the array it would return these results
Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis
Despite a Collection being mentioned and being a possible solution, it is far more efficient to use a Dictionary as it has an Exists method. Then it's just a matter of adding the names to the dictionary if they don't already exist, and then extracting the keys to an array when you're done.
Note that I've made the name comparisons case-sensitive, but you can change that if necessary, to case-insensitive.
Option Explicit
Sub test()
'Extract all of the names into an array
Dim values As Variant
values = Sheet1.Range("Names").Value2 'Value2 is faster than Value
'Add a reference to Microsoft Scripting Runtime
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'Set the comparison mode to case-sensitive
dic.CompareMode = BinaryCompare
Dim valCounter As Long
For valCounter = LBound(values) To UBound(values)
'Check if the name is already in the dictionary
If Not dic.Exists(values(valCounter, 1)) Then
'Add the new name as a key, along with a dummy value of 0
dic.Add values(valCounter, 1), 0
End If
Next valCounter
'Extract the dictionary's keys as a 1D array
Dim result As Variant
result = dic.Keys
End Sub
use Dictionary object and build a Function that returns your array
Function GetUniqeNames(myRng As Range) As Variant
Dim cell As Range
With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
For Each cell In myRng ' loop through passed range
.Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
Next
GetUniqeNames = .keys ' write referenced dictionary keys into an array
End With
End Function
that you can exploit in your main code as follows
Sub main()
Dim myArray As Variant
With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
End With
End Sub
Is this a VBA question or a question about programming logic? Use a loop on the column with the data. Check each name against the list of existing data items. If it exists in the list, move on the the next name. If it does not exist in the list, add it.
The "list" is a concept, not a concrete tool. It can be a VBA dictionary, if you are comfortable using that. Or it can be a VBA array, which may not perform as fast as a dictionary, but may be more familiar.
Then again, if you add the data to the Excel Data Model, you can use the Distinct aggregation of a pivot table to list out the unique values.
Without more background it's hard to tell if VBA or Data Model is your best approach. Many VBA solutions get created because people are not aware of Excel's capabilities.
You could use Excel functionality like that.
Sub UniqueNames()
Dim vDat As Variant
Dim rg As Range
Dim i As Long
Set rg = Range("A1:A7")
rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
With ActiveSheet
vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
End With
For i = LBound(vDat) To UBound(vDat)
Debug.Print vDat(i)
Next i
End Sub
Code is based on your example data, i.e. I put your data into column 1. But the code will also alter the table. If you do not want that you have to use other solutions or put the data beforehand in a temporary sheet.
If you dont want to use "Scripting.Dictionary" and your excel does not have Worksheet.unique(...) like mine
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
If UBound(arr) >= 0 Then
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
Else
IsInArray = False
End If
End Function
Public Function GetUniqueValuesFromColumn(ws As Worksheet, sourceColNum As Long, Optional firstRow As Long = 2) As Variant
Dim val As String
Dim i As Long
Dim arr() As Variant
arr = Array()
For i = firstRow To ws.Cells(Rows.Count, sourceColNum).End(xlUp).Row
val = ws.Cells(i, sourceColNum)
If Not IsInArray(val, arr) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
End If
Next i
GetUniqueValuesFromColumn = arr
End Function
Then call it like GetUniqueValuesFromColumn(ThisWorkbook.Worksheets("SomeList"), 1)
As the title suggests I am looking into different ways to store the contents of a query into an array. I have been experimenting with different varieties of doing this, but it seems to be that most of these ways are in correct in their output. This is of course do to my lack of understanding of how this is supposed to be appropriately done, so after a while of experimenting I have decided to ask whats the best approach for this? I will share with you some of my approaches thus far and you can see where my investigation has landed me.
Dim MyArray() As Variant
MyArray = rst.GetRows(rst.RecordCount)
This was ok yet this stored all the information vertically instead of horizontally. Is there a way to flip that? Would that be through the use of ReDim? Or is this due to the fact the rows are getting stored in array dimensions and thus they naturally vertical?
Index = 0
Do While Not rst.EOF
ReDim Preserve MyArray(1, Index)
MyArray(0, Index) = CStr(rst.Fields(0).Value)
'Safety check to make sure the value isn't null (was having problems before)
If rst.Fields(1).Value <> vbNullString Then
MyArray(1, Index) = CStr(rst.Fields(1).Value)
End If
Index = Index + 1
rst.MoveNext
Loop
sheet.Range("a1:ba10000").Value = MyArray
This again stored things vertically, but didnt output the records correctly, and in fact only pull the first two columns of info per record, the rest was output as #N/A#. I think I was closer with my original approach, but decided experimenting might land me somewhere.
Do you peeps have some suggestions or can point me in the right direction?
I think it would be quicker to just dump the results to the sheet using:
Sheet1.Range("A1").CopyFromRecordset rst
And then store the results of that dump (from the range) into an array. If it isn't vertical or horizontal like you like, a quick copy/paste-special transpose will make very quick work of it, before bringing it back into the array.
I'm only suggesting that since it seems like your recordset is rather large (2x10000), so iterating as you are doing is going to be time consuming, where dumping the results to the worksheet, manipulating, and picking them back up should be very very quick.
Update (many years later). Looks like it's possible to dump into an array. Something like:
Dim arr
rst.MoveFirst
arr = rst.GetRows
This would allow for programatic manipulation of the recordset (in the array) before shooting the data out to the workbook.
This should work to answer your Question, albeit 5 years late. Recordset to Array to Worksheet
ReDim Preserve can only be used to resize the upperbound of the last previous dimension. You don't have 1 yet, so no ReDim Preserve.
'Goes on Top
Option Explicit
Option Compare Text
Option Base 1
Public Sub Recordset_to_Array_to_Worksheet()
Dim MyArray() As Variant 'unbound Array with no definite dimensions'
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as String, Fieldname as String
Dim i as Integer, j as Integer, colcnt as Integer, rowcnt as Integer
Dim wb as Workbook
Dim ws as Worksheet
Dim Dest as Range
'------------------------RECORDSET------------------------'
Set db = Opendatabase("URL link") 'or Set db = Currentdb()
strSQL = "SQL Statement Here"
Set rst = db.OpenRecordset(strsQL, dbOpenDynaset)
If rst.recordcount <> 0 then '///Do NOT Use "Do While Not rst.EOF" Can cause Problems///'
colcnt = rst.Fields.Count-1
rowcnt = rst.recordcount
Else
Exit Sub
End IF
'-----------------------------WRITE RECORDSET TO MYARRAY----------------------------'
ReDim MyArray (rowcnt, colcnt) 'Redimension MyArray parameters to fit the SQL returned'
rst.MoveFirst
'Populating Array with Headers from Recordset'
For j = 0 To colcnt
MyArray(0,j) = rst.Fields(j).name
Next
'Populating Array with Record Data
For i = 1 to rowcnt
For j = 0 to colcnt
MyArray(i,j) = rst(j)
Next J
rst.movenext
Next i
'---------------------------------WORKSHEET OUTPUT---------------------------------'
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Insert Worksheet Name")
Set Dest = ws.Range("A1") 'Destination Cell
Dest.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).value =
Application.Transpose(MyArray) 'Resize (secret sauce)
End Sub
I am trying to create a dynamic number of variables in VBA based on the value in a cell.
Essentially what I'd like to end up with is something like Team1, Team2... to TeamX.
Any help is greatly appreciated
Dim i, x As Integer
Set x = Range("J4").Value
Dim Team(1 To x) As String
Dim Manager(1 To x) As String
Range("A3").Select
For i = 1 To x
Dim Team(i) As Integer
A dictionary would probably help in this case, it's designed for scripting, and while it won't let you create "dynamic" variables, the dictionary's items are dynamic, and can serve similar purpose as "variables".
Dim Teams as Object
Set Teams = CreateObject("Scripting.Dictionary")
For i = 1 To x
Teams(i) = "some value"
Next
Later, to query the values, just call on the item like:
MsgBox Teams(i)
Dictionaries contain key/value pairs, and the keys must be unique. Assigning to an existing key will overwrite its value, e.g.:
Teams(3) = "Detroit"
Teams(3) = "Chicago"
Debug.Print Teams(3) '## This will print "Chicago"
You can check for existence using the .Exist method if you need to worry about overwriting or not.
If Not Teams.Exist(3) Then
Teams(3) = "blah"
Else:
'Teams(3) already exists, so maybe we do something different here
End If
You can get the number of items in the dictionary with the .Count method.
MsgBox "There are " & Teams.Count & " Teams.", vbInfo
A dictionary's keys must be integer or string, but the values can be any data type (including arrays, and even Object data types, like Collection, Worksheet, Application, nested Dictionaries, etc., using the Set keyword), so for instance you could dict the worksheets in a workbook:
Dim ws as Worksheet, dict as Object
Set dict = CreateObject("Scripting.Dictionary")
For each ws in ActiveWorkbook.Worksheets
Set dict(ws.Name) = ws
Next
This will get you started. But before you start I recommend watching these WiseOwlTutorials tutorial on Youtube:
Selecting Cells (Range, Cells, Activecell, End, Offset)
Worksheets, Charts and Sheets
Variables
Arrays
Dim i, x As Integer
x = Range("J4").Value
Dim Team() As Integer
Dim Manager() As String
ReDim Team(1 To x) As Integer
ReDim Manager(1 To x) As String
Range("A3").Select
For i = 1 To x
Team(i) = i
Next
I have a workbook in which there are 5 sheets :
prize
volatility
size
value
growth
These five sheets have a ticker list (stocks name on index) in columns along with the dates . After every three months a new ticker list comes as a result of rebalancing for e.g. PRIZE sheet is having 2 rebalances so 2 ticker lists and SIZE sheet is having 4 rebalances so 4 ticker lists, so all these ticker lists are presented in the five different sheets. I want to make a macro which picks distinct unique values from these lists and paste it in another sheet in one column.
This will require a reference to the Microsoft Scripting Runtime. Go to the VB Editor, then Tools, References and select it from there.
After that, paste this code in a proc and see if it gets you over the line. It'll certainly push your knowledge in a new direction - dictionaries and arrays are amazing things in the right hands and utterly doom-laden in the wrong hands. You've been warned...!
Dim dctUniqueTickers As Dictionary
Dim dctTickerLocations As Dictionary
Dim arrCurrentTickerRange As Variant
Dim arrTickerOutput As Variant
Dim varSheetNames As Variant
Dim lngDctCounter As Long
Dim lngRowCounter As Long
Dim lngColCounter As Long
Dim lngAreaCounter As Long
' Set up the ticker location range(s)
Set dctTickerLocations = New Dictionary
With dctTickerLocations
.Add "prize", Application.Union(ThisWorkbook.Worksheets("prize").Range("A:A"), _
ThisWorkbook.Worksheets("prize").Range("C:C"))
.Add "size", Application.Union(ThisWorkbook.Worksheets("size").Range("A:A"), _
ThisWorkbook.Worksheets("size").Range("E:E"), _
ThisWorkbook.Worksheets("size").Range("F:F"), _
ThisWorkbook.Worksheets("size").Range("H:H"))
End With
' Populate the destination dictionary
Set dctUniqueTickers = New Dictionary
For Each varSheetNames In dctTickerLocations.Keys
' Looping through the keys (the worksheet names), pick up the associated range(s)
' - there may be multiple areas to consider
For lngAreaCounter = 1 To dctTickerLocations(varSheetNames).Areas.Count
arrCurrentTickerRange = dctTickerLocations(varSheetNames).Areas(lngAreaCounter)
For lngRowCounter = LBound(arrCurrentTickerRange, 1) To UBound(arrCurrentTickerRange, 1)
For lngColCounter = LBound(arrCurrentTickerRange, 2) To UBound(arrCurrentTickerRange, 2)
If LenB(arrCurrentTickerRange(lngRowCounter, lngColCounter)) > 0 Then
If Not dctUniqueTickers.Exists(arrCurrentTickerRange(lngRowCounter, lngColCounter)) Then
' Ticker not found within the dictionary, so add it
dctUniqueTickers.Add arrCurrentTickerRange(lngRowCounter, lngColCounter), arrCurrentTickerRange(lngRowCounter, lngColCounter)
End If
End If
Next
Next
Next
Next
If dctUniqueTickers.Count > 0 Then
lngDctCounter = 0
' Now output
ThisWorkbook.Worksheets("OutputSheet").Range("A1").Value = "Unique tickers"
For Each arrTickerOutput In dctUniqueTickers.Keys
ThisWorkbook.Worksheets("OutputSheet").Range("A2").Offset(lngDctCounter, 0).Value = CStr(arrTickerOutput)
lngDctCounter = lngDctCounter + 1
Next
End If
By using arrays it's lightning-fast and the extra check for empty cells only improves performance.
I have the following Data in Excel.
CHM0123456 SRM0123:01
CHM0123456 SRM0123:02
CHM0123456 SRM0256:12
CHM0123456 SRM0123:03
CHM0123457 SRM0789:01
CHM0123457 SRM0789:02
CHM0123457 SRM0789:03
CHM0123457 SRM0789:04
What I need to do is pull out all the relevent SRM numbers that relate to a single CHM ref. now I have a formular that will do some thing like this
=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))
however this is a bit untidy and I really want to produce this same using short vb script, do i jsut have to right a loop that will run though and check each row in turn.
For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next
which should give me a final string of
SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03
to use with how i want.
Or is ther a neater way to do this ?
Cheers
Aaron
my current code
For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value
End If
Next
MsgBox (outstring)
End Function
I'm not sure what your definition of 'neat' is, but here is a VBA function that I consider very neat and also flexible and it's lightning fast (10k+ entires with no lag). You pass it the CHM you want to look for, then the range to look in. You can pass a third optional paramater to set how each entry is seperated. So in your case you could write (assuming your list is :
=ListUnique(B2, B2:B6555)
You can also use Char(10) as the third parameter to seperat by line breaks, etc.
Function ListUnique(ByVal search_text As String, _
ByVal cell_range As range, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For Each cell In cell_range
If cell.Value = search_text Then
dict.Add cell.Offset(, 1).Value, 1
End If
Next
keys = dict.keys
For i = 0 To UBound(keys)
result = result & (seperator & keys(i))
Next
If Len(result) <> 0 Then
result = Right$(result, (Len(result) - Len(seperator)))
End If
ListUnique = result
Application.ScreenUpdating = True
End Function
How it works: It simple loops through your range looking for the search_string you give it. If it finds it, it adds it to a dictionary object (which will eliminate all dupes). You dump the results in an array then create a string out of them. Technically you can just pass it "B:B" as the search array if you aren't sure where the end of the column is and this function will still work just fine (1/5th of a second for scanning every cell in column B with 1000 unique hits returned).
Another solution would be to do an advancedfilter for Chm123456 and then you could copy those to another range. If you get them in a string array you can use the built-in excel function Join(saString, ",") (only works with string arrays).
Not actual code for you but it points you in a possible direction that can be helpful.
OK, this might be pretty fast for a ton of data. Grabbing the data for each cell takes a ton of time, it is better to grab it all at once. The the unique to paste and then grab the data using
vData=rUnique
where vData is a variant and rUnique is the is the copied cells. This might actually be faster than grabbing each data point point by point (excel internally can copy and paste extremely fast). Another option would be to grab the unique data without having the copy and past happen, here's how:
dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant
set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
vdata=reach
for i=lbound(vdata) to ubound(vdata)
sdata=sdata & vdata(i,1)
next l
next reach
Personally, I would prefer the internal copy paste then you could go through each sheet and then grab the data at the very end (this would be pretty fast, faster than looping through each cell). So going through each sheet.
dim wks as worksheet
for each wks in Activeworkbook.Worksheets
if wks.name <> "CopiedToWorksheet" then
advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
sData=sData & ","
next i
The above code should be blazing fast. I don't think you can use Join on a variant, but you could always attempt it, that would make it even faster. You could also try application.worksheetfunctions.contat (or whatever the contatenate function is) to combine the results and then just grab the final result.
On Error Resume Next
wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents