array references in a vba loop? - arrays

Question

OK... second attempt at posting this. Trying to make my question make sense please be patient with me, I am new at all of this.
The code below words PERFECTLY. It reads from the Range in column A and give me a string of all the cells where the searched numbers occur.
My only issue is its obviously not condensed at all. I have tried loops and arrays for the references but i can't seem to get it work. i would prefer something along the lines of reference(1-10) in stead of ref1, ref2, ref3. i had them all ref(i) with a loop around the whole macro but i ended up getting no results and an endless loop. any help to make this more streamlined would be appreciated. i have the full code if that will help anyone. I only put three iterations of the code it simply continues on with more references. up to 9
Option Explicit
Sub FindAircraftHourly()
Dim Findarray() As Integer 'the array to put numbers in
Dim count1, count2, count3, count4, count5, count6, count7, count8, count9 As Integer 'this will count the number of records you will need for your array
Dim n1, n2, n3, n4, n5, n6, n7, n8, n9 As Integer 'this will be what gets you through your For loops
Dim Searchvalue1, Searchvalue2, Searchvalue3, Searchvalue4, Searchvalue5, Searchvalue6, Searchvalue7, Searchvalue8, Searchvalue9 As Integer 'this is the number to look for
Dim Foundstring1, Foundstring2, foundstring3, foundstring4, foundstring5, foundstring6, foundstring7, Foundstring8, Foundstring9 As String 'this will build where the numbers are found
Dim k1 As Integer
Dim data As Worksheet
Set data = ThisWorkbook.Sheets("data")
If Cells(1, 3) <> "" Then 'test to make sure it has something to look for
Searchvalue1 = Cells(1, 3) * 1 'E18 is the search value for the function this converts it to number and not text
Else
MsgBox "No input found!", vbCritical 'if blank, give a warning and quit
GoTo the_end
End If
k1 = data.Range("A5000").End(xlUp).Row
count1 = 0 'always initialize your variables
For n1 = 1 To k1 'count through all the rows to find the end of the list
If Cells(n1, 1) <> "" Then 'is the cell blank or not?
count1 = count1 + 1 'if not blank, then increase the count
Else
Exit For 'if it's blank, stop looking and counting
End If
Next n1
ReDim Findarray1(0 To count1 - 1) As Integer 'array indexes start at 0, so subtract 1 to get the right number of elements
For n1 = 0 To UBound(Findarray1) 'go from the first element to the last of the array
Findarray1(n1) = Cells(n1 + 1, 1) 'load the array change the last number in the cells box to change where to start looking
Next n1
For n1 = 0 To UBound(Findarray1)
If Findarray1(n1) = Searchvalue1 Then
If Foundstring1 = "" Then 'if this is the first time found, create the string
Foundstring1 = n1 + 1
Else
Foundstring1 = Foundstring1 & ", " & n1 + 1 'if this is the second time the number is found, add a comma and continue to build the string.
End If
End If
Next n1
If Foundstring1 = "" Then
MsgBox "Not found", vbCritical 'msgbox nothing was found
Else
Cells(1, 4) = Foundstring1 'output the string to a certain cell
End If
'-----------------------------------------------------------------------
If Cells(2, 3) <> "" Then 'test to make sure it has something to look for
Searchvalue2 = Cells(2, 3) * 1 'E18 is the search value for the function this converts it to number and not text
Else
MsgBox "No input found!", vbCritical 'if blank, give a warning and quit
GoTo the_end
End If
k1 = data.Range("A5000").End(xlUp).Row
count2 = 0 'always initialize your variables
For n2 = 1 To k1 'count through all the rows to find the end of the list
If Cells(n2, 1) <> "" Then 'is the cell blank or not?
count2 = count2 + 1 'if not blank, then increase the count
Else
Exit For 'if it's blank, stop looking and counting
End If
Next n2
ReDim FindArray2(0 To count2 - 1) As Integer 'array indexes start at 0, so subtract 1 to get the right number of elements
For n2 = 0 To UBound(FindArray2) 'go from the first element to the last of the array
FindArray2(n2) = Cells(n2 + 1, 1) 'load the array change the last number in the cells box to change where to start looking
Next n2
For n2 = 0 To UBound(FindArray2)
If FindArray2(n2) = Searchvalue2 Then
If Foundstring2 = "" Then 'if this is the first time found, create the string
Foundstring2 = n2 + 1
Else
Foundstring2 = Foundstring2 & ", " & n2 + 1 'if this is the second time the number is found, add a comma and continue to build the string.
End If
End If
Next n2
If Foundstring2 = "" Then
MsgBox "Not found", vbCritical 'msgbox nothing was found
Else
Cells(2, 4) = Foundstring2 'output the string to a certain cell
End If
'-----------------------------------------------------------
If Cells(3, 3) <> "" Then 'test to make sure it has something to look for
Searchvalue3 = Cells(3, 3) * 1 'E18 is the search value for the function this converts it to number and not text
Else
MsgBox "No input found!", vbCritical 'if blank, give a warning and quit
GoTo the_end
End If
k1 = data.Range("A5000").End(xlUp).Row
count3 = 0 'always initialize your variables
For n3 = 1 To k1 'count through all the rows to find the end of the list
If Cells(n3, 1) <> "" Then 'is the cell blank or not?
count3 = count3 + 1 'if not blank, then increase the count
Else
Exit For 'if it's blank, stop looking and counting
End If
Next n3
ReDim FindArray3(0 To count3 - 1) As Integer 'array indexes start at 0, so subtract 1 to get the right number of elements
For n3 = 0 To UBound(FindArray3) 'go from the first element to the last of the array
FindArray3(n3) = Cells(n3 + 1, 1) 'load the array change the last number in the cells box to change where to start looking
Next n3
For n3 = 0 To UBound(FindArray3)
If FindArray3(n3) = Searchvalue3 Then
If foundstring3 = "" Then 'if this is the first time found, create the string
foundstring3 = n3 + 1
Else
foundstring3 = foundstring3 & ", " & n3 + 1 'if this is the second time the number is found, add a comma and continue to build the string.
End If
End If
Next n3
If foundstring3 = "" Then
MsgBox "Not found", vbCritical 'msgbox nothing was found
Else
Cells(3, 4) = foundstring3 'output the string to a certain cell
End If
the_end: 'end marker
End Sub

Answer 1

I'm not sure what your data looks like, but I would suggest a few things:
'finds the absolute last row with data in it // ignores empty cells
k1 = data.UsedRange.Rows.Count
count1 = 0
For n1 = 1 To k1
'here's a built-in function to help you check empty cells.
'if you're going to reference ranges, then you need to define on which worksheet
'you're referencing the ranges from. if you work with multiple worksheets, you
'can't simply use Cells(x,y); you need to use worksheet.Cells(x,y).
'If you want to access a cell's value, then you use the .Value property.
If Not IsEmpty(data.Cells(n1, 1).Value) Then
count1 = count1 + 1
Else
Exit For
End If
Next n1
I highly suggest using Collections instead of arrays because, for me, they're far easier to deal-with than arrays. They also start their indices at 1, so if you have a collection of 10 items, you count 1 through 10 instead of 0 through 9.
Defining and setting Collections:
Dim FindArray As New Collection
Or
Dim FindArray As Collection
Set FindArray = New Collection
Iterating over a collection:
Dim v As Variant
Dim sample As Double
For Each v In FindArray
'i personally like to recast all variant types to
'the intended data type
sample = v
'do your thing here
Next
Or
For i = 0 To FindArray.Count
'do your other thing here
Next
Here's my attempt at making your code cleaner; hope it helps!
PS: All my castings are based on assumptions, so change them to whatever type you were intending.
Main:
Dim wb As Workbook
Dim data As Worksheet
Dim n As Long
Dim SearchValue As Double
Dim Found As String
Dim output As New Collection
Dim FindArray As Collection
Dim count As Long
Dim k As Long
Dim i As Long
Dim j As Long
Set wb = Excel.Application.ThisWorkbook
Set data = wb.Worksheets("data")
k = data.UsedRange.Rows.Count
'find the last row before an empty record appears
For n = 1 To k
If Not IsEmpty(data.Cells(n, 1).Value) Then
count = n
ElseIf IsEmpty(data.Cells(n ,1).Value) Then
Exit For
End If
Next
'do the thing 9 times
For n = 1 To 9
If Not IsEmpty(data.Cells(n, 3).Value) Then
'cast the cell value to double and assign it to searchvalue
SearchValue = CDbl(data.Cells(n, 3).Value)
'i prefer to be extremely specific, but that's just me
Elseif IsEmpty(data.Cells(n, 3).Value) Then
MsgBox "No input found!", vbCritical
GoTo the_end
End If
'reset findarray to an empty collection
Set FindArray = New Collection
For i = 1 To count
'load your collection with the sample values casted to doubles
FindArray.Add CDbl(data.Cells(i, 1).Value)
Next
j = 1
Found = ""
For i = 1 To FindArray.Count
If FindArray(i) = SearchValue Then
If j = 1 Then
Found = i
ElseIf j > 1 Then
'im not sure what you're trying to accomplish with this line,
'so im just going to leave it as is and adjust it for my solution
'so it gives you the same output
Found = n & ", " & i
End If
j = j + 1
End If
Next
If Found = "" Then
MsgBox "Not found", vbCritical
Else
output.Add Found
End If
'i like to always just set the collection to nothing before a new iteration
Set FindArray = Nothing
Next
'dump all results in column 4
For i = 1 To output.Count
data.Cells(i, 4).Value = output(i)
Next
'garbage collection
Set FindArray = Nothing
Set output = Nothing
Set wb = Nothing
Set data = Nothing
the_end:
Exit Sub
I'm not entirely sure if this attempt at a solution will work for you, but I hope it's helpful in any way. Good luck!

Answer 2

Col A populated with values, Col C populated with search values to be found in Col A, Col D is where the row numbers of each value in Col C can be found.
The number of values in Col A and Col C are essentially limited only by the number of rows in your spreadsheet with no changes required to the code.
If you have not added a Dictionary reference, click on [Tools] at the top of the screen, click on [References...], scroll way down until you find [Microsoft Scripting Runtime], click the check mark next to that, then click [OK].
Sub FindAircraftHourly()
Dim dnySource As New Scripting.Dictionary
Dim strCellValue As String
Dim i0 As Long
With ActiveSheet
For i0 = 2 To .Rows.Count 'This starts at row 2 and goes to the end of the list. I'm assuming row 1 has a heading of some sort.
If Not IsEmpty(.Cells(i0, 1)) Then 'If the cell in col A of that row has a value, add that value to the dictionary as the key and the row number(s) as the items(s).
strCellValue = .Cells(i0, 1).Value
dnySource(strCellValue) = dnySource(strCellValue) & i0 & ", "
Else
Exit For 'Once you hit an empty cell, stop building the dictionary.
End If
Next i0
For i0 = 2 To .Rows.Count
If Not IsEmpty(.Cells(i0, 3)) Then 'If the cell in col C has a value then look through the dictionary to see if you have a list of row numbers to display.
strCellValue = .Cells(i0, 3).Value
If dnySource.Exists(strCellValue) Then 'If there is a list of row numbers for that value, display them in col D.
.Cells(i0, 4).Value = Left$(dnySource(strCellValue), Len(dnySource(strCellValue)) - 2) 'The - 2 here chops off the extra ", " at the end
Else 'Otherwise, indicate that the value in col C doesn't exist in col A.
.Cells(i0, 4).Value = "Value Not Found"
End If
Else
Exit For
End If
Next i0
End With
End Sub

Answer 3

Here's my attempt to solve your problem.
For questions just ask.
Option Explicit
Sub FindAircraftHourly()
Dim data As Worksheet
Dim searchrange As Range
Dim cell As Range
Dim findarray() As String
Dim searcharray() As Integer
Dim i As Integer
Set data = ThisWorkbook.Worksheets("data") 'the sheet your working on
Const maxinputvals As Integer = 3 'The number of search values you want to be looking for
ReDim searcharray(1 To maxinputvals) As Integer 'VBA doesn't need to start at 0
ReDim findarray(1 To maxinputvals) As String 'VBA doesn't need to start at 0
i = 0 'not needed but always nice to make sure
Do
i = i + 1 'add 1 to the count-var
If i > maxinputvals Then Exit Do 'if the count-var si bigger than max number of searchvalues quit the loop
If data.Cells(i, 3) <> "" Then 'check if cells is not empty
searcharray(i) = data.Cells(i, 3).Value 'safe the searchvalue
Else
MsgBox "Searchvalue #" & i & " is missing." 'exit the sub if a searchvalue is missing
Exit Sub
End If
Loop
Set searchrange = data.Range("A1:A5000")
For Each cell In searchrange 'go through the whole range
If cell.Value <> "" Then 'check is cell is empty
For i = 1 To maxinputvals 'if not, check if match with one of the searchvals
If cell.Value = searcharray(i) Then
findarray(i) = findarray(i) & ", " & cell.Row 'append your findarray string
End If
Next i
Else
Exit For 'if cell is empty exit the loop
End If
Next cell
For i = 1 To maxinputvals
findarray(i) = Mid(findarray(i), 3) 'delete the first ", "
data.Cells(i, 4) = findarray(i) 'output the findstring
Next i
End Sub