Create a VBA Array from Column Headers? - arrays

I have a an export "NewExport" that always randomizes the columns of data I receive. I need these columns to align with the order of columns in "TheOrder", so this code will help to re-organize the export to align with the column headers I've already built.
I have 132 columns that need re-alignment, and while I can type it all out, there must be an easier way to align with the column headers I've already created. It should be noted that the below code is shamelessly copy/pasted from another StackOverflow answer.
Sub OrderColumns(ByVal NewExport As Workbook, ByVal TheOrder As Worksheet)
Dim correctOrder() As Variant
Dim lastCol As Long
Dim headerRng As Range, cel As Range
Dim mainWS As Worksheet
Set mainWS = NewExport.Worksheets("Sheet1")
'Need to figure out how to make this an array based on a Range
correctOrder() = Array(TheOrder.Range("A1:A132").Value)
With mainWS
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set headerRng = .Range(.Cells(1, 1), .Cells(1, lastCol))
End With
Dim newWS As Worksheet
Set newWS = Ninja.Sheets.Add
newWS.Name = "Rearranged Sheet"
Dim col As Long
With newWS
For col = 1 To lastCol
For Each cel In headerRng
If cel.Value = correctOrder(col - 1) Then
mainWS.Columns(cel.Column).Copy .Columns(col)
Exit For
End If
Next cel
Next col
End With
End Sub

While it's not as automated as I would have liked (and requires one piece of hard-coding), I was able to find a solution as such:
Dim correctOrder(132) As Variant
'132 will need to be changed if there's ever any more/less columns added/excluded
For i = 1 To 132
correctOrder(i - 1) = TheOrder.Range("A" & i).Value
Next
This solution gave me the array I was looking for for use later on.

I recently wrote a 'column finder' function for a project of mine.
I've modified it to suit your requirements below.
The function requires you pass the workbook your correct ordered headings are in to capture. You could modify this to require your TargetWorksheet instead so it's a bit more dynamic.
The function returns a single dimension Array.
The function finds the last used Column in the Target Worksheet allowing for changes in the number of column headings (as mentioned in your own answer which has the column number hard coded).
Public Function CorrectOrderHeadingsArrayFunction(ByRef TargetWorkbook As Workbook) As Variant()
With TargetWorkbook.Sheets(1) 'Change this to target your correct sheet
Dim LastColumn As Long
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
CorrectOrderHeadingsArrayFunction= Application.Transpose(Application.Transpose(.Range(.Cells(1, 1), .Cells(1, LastColumn)).Value)) 'This returns the array as single dimension rather than 2D
End With
End Function
As an example, below is some sample 'Test' code to show the concept of using this function .
You could call it like so, and loop through each element perhaps comparing another arrays elements to the correct order elements and do something when the correct order value is found.
Sub TestSub()
Dim CorrectOrderArray As Variant
Dim TargetCorrectOrderElement As Variant
Dim RandomOrderArray As Variant
Dim TargetRandomOrderElement As Variant
CorrectOrderArray = CorrectOrderHeadingsArrayFunction(Workbooks("Export (4).csv")) 'Change this to target your correct workbook
RandomOrderArray = Sheet1.Range("A1:AZ1000") 'Change this to target the correct range for your data.
For Each TargetCorrectOrderElement In CorrectOrderArray
For TargetRandomOrderElement = LBound(RandomOrderArray) To UBound(RandomOrderArray)
If RandomOrderArray(TargetRandomOrderElement) = TargetCorrectorderValue Then
'Do some code to write that column to your worksheet
Exit For 'Leaves the current iteration of the random order array loop to go to the next iteration of the correct order array
End If
Next TargetRandomOrderElement
Next TargetCorrectOrderElement
End Sub

Related

Extract subarray from jagged array and use as 1d array

I'm trying to reduce redundancy in my macros but I'm struggling with getting an element from a jagged array and using it elsewhere.
The premise is a single workbook with many sheets being split by groups of sheet names into new documents that I can then send to the process owners so they only get their own data.
Previously I was selecting sheet names listed explicitly and pasting to a new document that was named explicitly, but I had to run 10 separate almost identical macros to do that and I have heard of select being a bad choice in many instances as well.
Below is my latest attempt, the first issue is at the printOut line I get a Type Mismatch.
Sub CopyOut()
Dim printOut, groupNames, Group1, groupArray() As Variant
Dim n, j As Long
Dim reNamed, fileName As String
Dim ws As Worksheet
Dim wb1, wb2 As Workbook
groupNames = Array("Group 1", "Group 2", "Group 3", "Group 4") 'other arrays left off for length
Group1 = Array("FA_1A Report", "FA_1A", "FA_2ACS Report", "FA_2ACS", "FA_2BCS Report", "FA_2BCS", "FANUCMED Report", "FANUCMED", "FA_RRTP1 Report", "FA_RRPT1")
groupArray = Array(groupNames, Group1)
For n = 1 To UBound(groupArray)
fileName = "CS Data Sheet" & " " & Format(Date, "mmmyy") & "-" & groupArray(n - n)(n - 1) & ".xlsm" 'concat file name string. this is not just tacked on the end of reName because i use it on it's own later
reNamed = "C:\Users\xx\Desktop\" & fileName 'concat save location string
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add 'create a new workbook, wb2
wb2.SaveAs fileName:=reNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'save with that name and location
printOut = Join(Application.Index(groupArray, n, 0), ",")
wb1.Sheets(printOut).Copy Before:=Workbooks(fileName).Sheets(1) 'copy the sheets for the group and paste into the newly created document
Next
End Sub
If I nix printOut altogether and put in a specific worksheet name instead it does work for just that one sheet (of course) but I need it to copy multiple to each new document.
I have also tried:
For n = 1 To UBound(groupArray)
...
for j= LBound(groupArray(n)) To UBound(groupArray(n))
wb1.Sheets(groupArray(n)(j)).Copy Before:=Workbooks(fileName).Sheets(1)
next
next
to iterate through the subarray and copy a sheet at a time, but it gives subscript out of range. With this version I tried various methods of making the groupArray(n)(j) value into a string or into a "worksheet" type to set as a variable and use the variable in the sheets().copy, to no avail.
Any idea where I could be going wrong?
thanks so much
EDIT:
I got my above code working by wrapping it in split (was trying to use printOut as an array when it was only a string) and fixing the arguments of Index as below, however the resulting code still needs work, since if a sheet is missing it won't run.
printOut = Split(Join(Application.Index(groupArray(n), 1, 0), ","), ",")
In my experience, if you find yourself hard-coding values like sheet names, group names, and other data directly in your code it tends to become difficult to maintain. Adding more groups, or re-shuffling the sheets in each group becomes problematic. My recommendation is to create a (possibly hidden) worksheet that maps your worksheet names into groups. Then you have a small set of code that operates directly on that.
My example data is set up like this:
Next, in its own code module, I created a few methods to work directly with this group map data. The main idea here is to move the group map data into a memory-based array. While in general I rarely use module-level global variables, I have one in this example to illustrate how to work with the data by only reading it into the array once every time the macro is executed.
(These are Subs and Functions. For my own code, I likely would have created a VBA class to handle the data in an object-oriented way.)
So there is a Private Sub to get the data:
Option Explicit
Private groupData As Variant
Private Sub GetGroupData()
Const GROUP_WS_NAME As String = "GroupMap"
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(GROUP_WS_NAME)
Dim lastRow As Long
Dim lastCol As Long
With ws
'--- how many columns of groups?
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .UsedRange.Find("*", , , , xlByRows, xlPrevious).Row
groupData = .Range("A1").Resize(lastRow, lastCol).Value
End With
End Sub
Now it's easy to figure out how many groups there are:
Public Function NumberOfGroups() As Long
If IsEmpty(groupData) Then GetGroupData
NumberOfGroups = UBound(groupData, 2)
End Function
And how many items in a particular group:
Public Function NumberInGroup(ByVal groupNumber As Long)
If IsEmpty(groupData) Then GetGroupData
'--- count the number of array values that have data
Dim i As Long
For i = LBound(groupData, 1) To UBound(groupData, 1)
If groupData(i, groupNumber) = vbNullString Then
'--- we found the first empty cell in this array, we're done
Exit For
Else
NumberInGroup = NumberInGroup + 1
End If
Next i
'--- subtract one to discount the header value
NumberInGroup = NumberInGroup - 1
End Function
The easiest of all is getting the value of any group:
Public Function GetGroupValue(ByVal groupNumber As Long, _
ByVal groupIndex As Long) As Variant
If IsEmpty(groupData) Then GetGroupData
'--- always add one to the index to account for the header value
GetGroupValue = groupData(groupIndex + 1, groupNumber)
End Function
Notice the check for If IsEmpty(groupData) Then GetGroupData at the beginning of each method. This makes sure the groupData array is always loaded if necessary.
This example gives it a quick test (in a different code module):
Option Explicit
Sub test()
Dim totalGroups As Long
totalGroups = NumberOfGroups()
Dim i As Long
Dim j As Long
For i = 1 To totalGroups
Dim totalInGroup As Long
totalInGroup = NumberInGroup(i)
For j = 1 To totalInGroup
Debug.Print "group " & i & " = " & GetGroupValue(i, j)
Next j
Next i
End Sub
Here's the whole group data code module in a single block:
Option Explicit
Private groupData As Variant
Private Sub GetGroupData()
Const GROUP_WS_NAME As String = "GroupMap"
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(GROUP_WS_NAME)
Dim lastRow As Long
Dim lastCol As Long
With ws
'--- how many columns of groups?
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .UsedRange.Find("*", , , , xlByRows, xlPrevious).Row
groupData = .Range("A1").Resize(lastRow, lastCol).Value
End With
End Sub
Public Function NumberOfGroups() As Long
If IsEmpty(groupData) Then GetGroupData
NumberOfGroups = UBound(groupData, 2)
End Function
Public Function NumberInGroup(ByVal groupNumber As Long)
If IsEmpty(groupData) Then GetGroupData
'--- count the number of array values that have data
Dim i As Long
For i = LBound(groupData, 1) To UBound(groupData, 1)
If groupData(i, groupNumber) = vbNullString Then
'--- we found the first empty cell in this array, we're done
Exit For
Else
NumberInGroup = NumberInGroup + 1
End If
Next i
'--- subtract one to discount the header value
NumberInGroup = NumberInGroup - 1
End Function
Public Function GetGroupValue(ByVal groupNumber As Long, ByVal groupIndex As Long) As Variant
If IsEmpty(groupData) Then GetGroupData
'--- always add one to the index to account for the header value
GetGroupValue = groupData(groupIndex + 1, groupNumber)
End Function
If I got this right, you have one master workbook with n sheets and you want to group some of them, then create a new workbook for each group and paste in its assigned sheets.
I think an approach where you keep a "config" file in your master workbook for setting up groups and sheets, is more suitable rather than editing into code. Example:
The below code will create a file using the names from column A and copy all the sheets defined on their respective row.
Option Explicit
Sub CopyOut()
Dim groupArr() As Variant
Dim wb2 As Workbook
Dim lastRow As Long, lastCol As Long, highestNumOfSheets As Long, i As Long, j As Long, arrColumns As Long
Dim reNamed As String, fileName As String, configSheet As String
Dim removedSheet1 As Boolean
' Modify the sheet name here
configSheet = "config"
' Build an array from sheet defined groups
With ThisWorkbook.Worksheets(configSheet)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
lastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
If lastCol > highestNumOfSheets Then highestNumOfSheets = lastCol
Next i
groupArr = .Range(.Cells(2, 1), .Cells(lastRow, highestNumOfSheets)).Value2
End With
Application.ScreenUpdating = False
For i = LBound(groupArr) To UBound(groupArr)
fileName = "CS Data Sheet " & Format(Date, "mmmyy") & "-" & groupArr(i, 1) & ".xlsm"
reNamed = Environ("UserProfile") & "\Desktop\" & fileName
removedSheet1 = False ' Reset this on each new workbook created
Set wb2 = Workbooks.Add
' Pick all the sheet names for the current group
For j = 2 To UBound(groupArr, 2)
' Skip empty values from array (if it's the case) and skip missing sheets
If Trim(groupArr(i, j)) <> vbNullString And SheetExists(groupArr(i, j)) Then
ThisWorkbook.Worksheets(groupArr(i, j)).Copy Before:=wb2.Worksheets(1)
' Remove Sheet1 from the new Workbook
If removedSheet1 = False Then
With Application
.DisplayAlerts = False
wb2.Worksheets("Sheet1").Delete
removedSheet1 = True
.DisplayAlerts = True
End With
End If
End If
Next j
' Here you might need an error handler if you think you're going to run the macro multiple times in the same day
' If the file exists already this will throw an error
' A quick lazy way is to add time (including seconds) when you define the file name above
wb2.SaveAs fileName:=reNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb2.Close
If Not wb2 Is Nothing Then Set wb2 = Nothing
Next i
Application.ScreenUpdating = True
End Sub
Function SheetExists(ByVal sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0
If Not ws Is Nothing Then
SheetExists = True
Set ws = Nothing
End If
End Function
Of course it can be tweaked around, with error handling and other checks (depending on what you want to achieve entirely) but it should give you an alternative view of your code.
EDIT: Added a function to check if sheet exists.

Delete all contents except for first row for specific sheets in Excel

Please assist. I have this code here and it works for first sheet however, does not execute in the 2nd sheet. I think i'm missing a sheet syntax. thanks.
Dim arrSheets As Variant, sht As Variant
arrSheets = Array("tl_1", "tl_2")
For Each sht In arrSheets
Sheets(sht).UsedRange.Offset(1).ClearContents
Next sht
My 2 cents: do not rely on worksheet names. Instead, work with their (Name) property as seen from the Visual Basic Editor. Note that you can give significant names yourself instead of the default Sheet1..N ones. This way, your code will survive modifications to the names as seen from Excel, in the tabs at the bottom.
Option Explicit
Public Sub DoTheClearThing()
Dim loopVariant As Variant
Dim loopWorksheet As Excel.Worksheet
Dim worksheetsToConsider As Variant
'Use the (Name) property, as seen from the Visual Basic Editor, of the worksheets you're interested in.
'The array below is not a string array; it is an array of worksheet objects.
worksheetsToConsider = Array(TL_1, TL_2)
'The For's variable must be a Variant; you can then Set it to a variable of the Worksheet type and enjoy Intellisense.
For Each loopVariant In worksheetsToConsider
Set loopWorksheet = loopVariant
loopWorksheet.UsedRange.Offset(1).ClearContents
Next
End Sub
Here's what the worksheets' (Name) properties look like in my test Excel workbook:
From within your workbook's code, you can directly interact with worksheet objects using their (Name) property. Avoid ThisWorkbook.Worksheets("tl_1").SomeMethod and directly go with TL_1.SomeMethod. By the way, a worksheet's (Name) property can be read by code using its CodeName property.
Option Explicit
'This will do something to your target sheets,
'just make sure your "something" is what you want
Dim N As Long
Dim wsName As String
'Optional if included
For N = 1 To ThisWorkbook.Sheets.Count
wsName = ThisWorkbook.Worksheets(N).Name
If wsName = "tl_1" or wsName = "tl_2" Then
ThisWorkbook.Worksheets(N).UsedRange.Offset(1).ClearContents
Else 'Do Nothing
End If
Next N
Note: This is very worksheet name dependent and users can change those if you are not the only user. You may want to CodeName your sheets (properties Explorer and change the Name) then pull the CodeName.
You can use an array to hold the sheets names but it seems like more trouble than its worth unless you are going to load the names into the array.
-WWC
Worksheet.UsedRange does not always return the correct address. Consider the results of the test below:
Test Used Range
Sub Test()
Application.ScreenUpdating = False
Dim cell As Range, target As Range
Debug.Print "Data Range", "|"; "UsedRange"
Debug.Print String(24, "_")
With Worksheets.Add
Set target = .Range("B2:D2")
target.Value = 1
Debug.Print target.Address, "|"; .UsedRange.Address
End With
With Worksheets.Add
.Range("A1:G10").Interior.Color = 65535
Set target = .Range("B2:D2")
target.Value = 1
Debug.Print target.Address, "|"; .UsedRange.Address
End With
End Sub
Clear Non-Headers
Sub ClearNonHeaderRows()
Dim arrSheets As Variant, sht As Variant
Dim cell As Range
arrSheets = Array("tl_1", "tl_2")
For Each sht In arrSheets
With Worksheets(sht).UsedRange
Set cell = .Find("*", .Cells(1, 1))
If Not cell Is Nothing Then
cell.Offset(1).Resize(.Cells.Rows.Count - cell.row + .Cells(1, 1).row).EntireRow.ClearContents
End If
End With
Next sht
End Sub

Cut and paste row if columns AC-AF contain blanks

What I am trying to accomplish is this:
If any cells in columns AC-AF in my entire worksheet are blank, cut the entire row and paste to a new worksheet labeled "MissingShipping".
Code should adjust with the amount of rows, since that will never be the same.
From examples I have seen I don't understand where to insert the range of the cells I want to wade through.
I get the error
"Method 'Range' of object'_Worksheet'
on the line NewSetup.Range(Cells(Destinationrow, 1), Cells(Destinationrow, lastcolumn)).Select.
Option Explicit
Sub Shipping()
Dim MissingShipping As Worksheet
Set MissingShipping = Sheets.Add(After:=Sheets(Sheets.Count))
MissingShipping.Name = "MissingShipping"
Dim NewSetup As Worksheet
Dim lastcolumn As Integer
Dim Destinationrow As Integer
Dim lastrow As Long
Set NewSetup = Worksheets("NKItemBuildInfoResults")
Set MissingShipping = Worksheets("MissingShipping")
Destinationrow = 1
lastcolumn = NewSetup.Range("XFD1").End(xlToLeft).Column
lastrow = NewSetup.Range("A1048576").End(xlUp).Row
Dim i As Long
Dim j As Long
For i = lastrow To 1 Step -1
For j = 1 To lastcolumn
If NewSetup.Cells(i, j).Value = "" Then
NewSetup.Activate
NewSetup.Range(Cells(i, 1), Cells(i, lastcolumn)).Cut
MissingShipping.Activate
NewSetup.Range(Cells(Destinationrow, 1), Cells(Destinationrow, _
lastcolumn)).Select
ActiveSheet.Paste
NewSetup.Rows(i).Delete shift:=xlUp
Destinationrow = Destinationrow + 1
Exit For
End If
Next j
Next i
End Sub
G'day Nikki,
Welcome to the world of VBA! There are plenty of great resources on the internet to help you on your journey.
It's often easier and faster to work with a range inside your code instead of reading and writing to a sheet and selecting cells to mimic things that you would normally do if you were doing the job manually.
It's a good idea to get your head around the range object early on. It's handy for working with multiple worksheets.
The following is a good start with Ranges in Excel:
https://excelmacromastery.com/excel-vba-range-cells/
Another handy thing is a collection. If you had to store a bunch of things to work with later on, you can add them to a collection then iterate over them using a "For Each" loop. This is a good explanation of collections:
https://excelmacromastery.com/excel-vba-collections/
I had a quick look at your code and using the concept of Ranges and Collections, I have altered it to do what I think you were trying to do. I had to make a few assumptions as I haven't seen you sheet. I ran the code on a bunch of random rows on my computer to make sure it works. Consider the following:
Dim MissingShipping As Worksheet
Dim NewSetup As Worksheet
Dim rangeToCheck As Range
Dim cellsToCheck As Range
Dim targetRange As Range
Dim rw As Range 'rw is a row
Dim cl As Range 'cl is a cell
Dim rowColl As New Collection
Dim i As Long
Set NewSetup = Worksheets("NKItemBuildInfoResults")
Set MissingShipping = Worksheets("MissingShipping")
'Get the range of data to check
Set rangeToCheck = NewSetup.Range("A1").CurrentRegion
'For each row in the range
For Each rw In rangeToCheck.Rows
'For the last four cells in that row
Set cellsToCheck = rw.Cells(1, 29).Resize(1, 4)
For Each cl In cellsToCheck.Cells
'If the cell is empty
If cl.Value = "" Then
'Add the row to our collection of rows
rowColl.Add rw
'Exit the for loop because we only want to add the row once.
'There may be multiple empty cells.
Exit For
End If
'Check the next cell
Next cl
Next rw
'Now we have a collection of rows that meet the requirements that you were after
'Using the size collection of rows we made, we now know the size of the range
'we need to store the values
'We can set the size of the new range using rowColl.Count
'(that's the number of rows we have)
Set targetRange = MissingShipping.Range("A1").Resize(rowColl.Count, 32)
'Use i to step through the rows of our new range
i = 1
'For each row in our collection of rows
For Each rw In rowColl
'Use i to set the correct row in our target range an make it's value
'equal to the row we're looking at
targetRange.Rows(i) = rw.Value
'Increment i for next time
i = i + 1
Next rw
End Sub
Good luck! Hope this helps.

error 424 object required error

I'm trying to input the values in a range of cells into an array.
the following code give me an error 424 object required message. Please help
feedingtypes() = wbfeedingtypes.Range("A2:A" & lrowfeedingtypes).Value
I have run and tested the following
Sub RangeToArray()
Dim i As Long
Dim ws As Worksheet
Dim myRange As Range, cell As Range
Dim feedingtypes() As String
Set ws = ThisWorkbook.Worksheets(1)
Set myRange = ws.Range("A1:A20")
i = 1
For Each cell In myRange
'Only add non blanks
If cell.Value <> "" Then
'Resize the array each time another cell is added
ReDim Preserve feedingtypes(i)
feedingtypes(i) = cell.Value
i = i + 1
End If
Next cell
End Sub
I believe this is what you're looking for:
Dim feedingtypes() As Variant
feedingtypes = wbfeedingtypes.Sheets(1).Range("A2:A" & lrowfeedingtypes)
Note, that there are not brackets in the second line of code after the variable name.
Based on your comments it seems there is only one worksheet. Hence, you can also refer to the sheet by number. I changed the answer accordingly.

VBA Why does Application.Countif return an array or error 424

I would like to count the number of matching items in an array. I tried using
Application.Countif
MyCount = Application.WorksheetFunction.CountIf(Myrange, val)
but this returns an array full of errors rather than a simple count. I have also tried using Application.WorksheetFunction.Countif but this causes a 424 error.
I currently am testing on a worksheet with a short list of names in cells A1:A20, but ultimately I plan to use this code with a very large CSV file and I want to load the information into an array before using CountIf (rather than using the range).
Sub TestCount()
Dim MyCount
Dim Myrange As Variant
Dim val As String
val = "Addison"
Myrange = ActiveSheet.Range("A1").CurrentRegion.Value
MyCount = Application.WorksheetFunction.CountIf(Myrange, val)
MsgBox (MyCount)
End Sub
Can anyone suggest what I did wrong?
You have several problems.
Using CountIf
First, if I understand right, you are intentially trying to use the Application.WorksheetFunction.CountIf statement on an array. That will only cause trouble, since CountIf (as the statment suggests) is a "worksheet function" not a "VBA Array function".
Ditto has created a solution that uses CountIf correctly, by setting a range in the worksheet on which the CountIf statement performs its job. If all you want is a way to count the value within that range, that is the way to go.
Creating an array from a range
Second, if you really need to get the items out of the worksheet and into an array (for example, if you plan to work with those values in ways you don't want to effect the worksheet), you should know that you have only partially solved the question of creating an array of values from a range selection.
You are correct that to establish an array by assigning a range to a variable you need a variant, but you have forgotten the parenthesis, which are an essential part of denoting an array.So, instead of Dim Myrange As Variant you should use Dim Myrange () As Variant
Having established MyRange as an array, you can now assign the array values by saying MyRange = Range("x") where x is the area being captured. You do not need to (or want to) use .Value for this. VBA will automatically do that for you. So, in your case you want to use the CurrentRegion for Range("A1") which is done like this: MyRange = Range("A1").CurrentRegion. You could also use a closely defined range like this: MyRange = Range("A1:A12") or MyRange = Range("C7:F14"). Note: I left off the ActiveSheet because it does not work when assigning ranges to arrays. The assumption is that you are using the active sheet, and the current region is for the cell indicated in the Range("x") statement.
Counting values within the array
Third, once you have succeeded in creating an array, you won't be able to use Countif (as noted above). You'll need to create a method of counting that value within the array. There are several considerations in doing this.
Since an array created from a range will be two dimensional and may have more than one column, you should not assume just one column. You will want to create a variable that holds the number of rows and number of columns, so you can loop through the entire array. Something like this:
Dim Row As Long
Dim Col As Long
You will want to define the limits of your loops using the UBound of the array dimensions. Something like this:
Dim RowNumber As Integer
RowNumber = UBound(MyRange, 1)
Dim ColNumber As Integer
ColNumber = UBound(MyRange, 2)
Code for using an array to find your count
I think the following code will do what you want using an array created in the manner you were attempting:
Sub TestCount()
Dim MyCount As Long
MyCount = 0
Dim MyRange() As Variant
MyRange = Range("A1").CurrentRegion
Dim val As String
val = "Addison"
Dim Row As Long
Dim Col As Long
Dim RowNumber As Long
RowNumber = UBound(MyRange, 1)
Dim ColNumber As Long
ColNumber = UBound(MyRange, 2)
For Col = 1 To ColNumber
For Row = 1 To RowNumber
If MyRange(Row, Col) = val Then MyCount = MyCount + 1
Next Row
Next Col
msgbox MyCount
End Sub
Just because this horse hasn't been beat enough already..here is a 1 liner
Sub Button3_Click()
MsgBox Application.WorksheetFunction.CountIf(Range("A1:a20"), "Addison")
End Sub
Try this:
Sub TestCount()
Dim MyCount
Dim Myrange As Range
Dim val As String
val = "Addison"
Set Myrange = ActiveSheet.Range("A1:a20")
MyCount = Application.WorksheetFunction.CountIf(Myrange, val)
MsgBox (MyCount)
End Sub
1) define "Myrange" as a RANGE, not a variant.
2) use "set" keyword to assign range to Myrange
3) give it the range you want: "a1:a20", not just "a1"
Yes, you didn't declare you range as a range type, so you didn't set the range.
Sub Macro1()
Dim val as String
Dim r As Range
Set r = Range("a1:a20")
val = "Addison"
MsgBox Application.WorksheetFunction.CountIf(r, val)
End Sub
or
Sub CritSrh_Column()
Dim cell As Variant
Dim counter As Integer
For Each cell In Range("A1:A20")
'could use ("A:A") to search the whole column #not recommended#
'for dynamic rows, use end.xl('direction')
If cell.Value = "Addison" Then
counter = counter + 1
End If
Next
MsgBox counter
End Sub

Resources