I've been trying to research this for a while now. I'm trying to write a function that will find the last populated row in column B (Starting at B9), and add the string values in column B into an array.
Any help would be much appreciated, thanks everyone.
Option Explicit
Function locationSum2(location) As Integer
Dim arrayLength As Integer
arrayLength = LastRowInColumn(2) - 9
Dim arrayPosition As Integer
Dim locationColumn() As String
ReDim locationColumn(0 To arrayLength) As String
Dim celltext As String
Dim i As Integer
For i = 0 To i = arrayLength
celltext = Cells((9 + i), 2).Text
locationColumn(i) = celltext
Next i
For arrayPosition = 0 To arrayPosition = UBound(locationColumn)
If location = locationColumn(arrayPosition) Then
locationSum2 = locationSum2 + Cells(arrayPosition + 9, 11).Value
End If
Next arrayPosition
locationSum2 = locationSum2
End Function
Following a comment, I also chopped the code way down to basically just a loop that check the argument against everything in column B instead of making an array.
Option Explicit
Function locationSum2(location) As Integer
Dim LastRow As Integer
LastRow = LastRowInColumn(2)
Dim i As Integer
For i = 9 To i = LastRow
If location = Cells(i, 2).Text Then
locationSum2 = locationSum2 + Cells(i, 11).Value
End If
Next i
locationSum2 = locationSum2
For whatever reason, it still doesn't seem to be reading Column B properly. It's returning a value of 0 so it doesn't seem to be finding a match.
You've setup the for loops incorrectly.
For i = 9 To i = LastRow
should be
For i = 9 To LastRow
I'm not sure if that is you're only problem, but lets start there
Related
I am trying to assign an array to a range of values in an Excel sheet.
When I do though, even though using debug the array is not all zeros, it returns all zeros.
The weird thing is for the dat1 variable it does write to the cells correctly. Though that along with dat2 is an array of strings.
Thanks in advance.
Sub Comparor()
Dim dat1() As Variant
Dim dat2() As Variant
dat1() = Sheets("Data1").Range("E1:E10").Value2
dat2() = Sheets("Data2").Range("E1:E10").Value2
Dim iTemp As Integer
iTemp = CInt(UBound(dat1))
Dim NumMatches() As Integer
ReDim NumMatches(iTemp)
Dim iNum As Integer
Dim iCompareInner As Integer 'dat 2 cycler
Dim iCompareOuter As Integer 'dat 1 cycler
For iCompareOuter = 1 To UBound(dat1)
For iCompareInner = 1 To UBound(dat2)
If (dat1(iCompareOuter, 1) = dat2(iCompareInner, 1)) Then
NumMatches(iCompareOuter) = NumMatches(iCompareOuter) + 1
End If
Next iCompareInner
Next iCompareOuter
Dim test22(10, 1) As Integer
For iNum = 1 To UBound(NumMatches)
'Debug.Print NumMatches(iNum)
test22(iNum, 1) = NumMatches(iNum)
Debug.Print test22(iNum, 1)
Next iNum
Sheets("Info").Range("E1:E10").Value2 = dat1
Sheets("Info").Range("F1:F10").Value2 = test22
Sheets("Info").Range("G1:G10").Value2 = NumMatches
End Sub
Count Matches (Dictionary, CountIf, Array (Double-Loop))
All three solutions do the same thing.
Using them with some serious data, e.g. 1K uniques on 100K values (means e.g. 100M iterations in the array version) will reveal the efficiency of each code.
But this is more about 2D one-based (one-column) arrays commonly used with (one-column) ranges.
The code is basic i.e. no blanks or error values are expected and each range has at least 2 cells
(i.e. Data = rg.Value with one cell doesn't work).
Option Explicit
Sub ComparorDictionary()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Read values (duplicates)
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vData() As Variant: vData = vws.Range("E1:E10").Value
Dim vrCount As Long: vrCount = UBound(vData, 1)
' Count matches using a dictionary.
Dim vDict As Object: Set vDict = CreateObject("Scripting.Dictionary")
vDict.CompareMode = vbTextCompare
Dim vr As Long
For vr = 1 To vrCount
vDict(vData(vr, 1)) = vDict(vData(vr, 1)) + 1
Next vr
Erase vData ' values data is counted in the dictionary
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Write count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim ur As Long
For ur = 1 To urCount
If vDict.Exists(uData(ur, 1)) Then
uMatches(ur, 1) = vDict(uData(ur, 1))
End If
Next ur
Set vDict = Nothing ' data is in the unique arrays
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
Sub ComparorCountIf()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference values (duplicates). No array is needed.
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vrg As Range: Set vrg = vws.Range("E1:E10")
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Count matches and write the count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim ur As Long
For ur = 1 To urCount
uMatches(ur, 1) = Application.CountIf(vrg, uData(ur, 1))
Next ur
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
Sub ComparorArray()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Read values (duplicates).
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vData() As Variant: vData = vws.Range("E1:E10").Value
Dim vrCount As Long: vrCount = UBound(vData, 1)
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Count matches and write the count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim vr As Long
Dim ur As Long
For ur = 1 To urCount
For vr = 1 To vrCount
If uData(ur, 1) = vData(vr, 1) Then
uMatches(ur, 1) = uMatches(ur, 1) + 1
End If
Next vr
Next ur
Erase vData ' data is in the unique arrays
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
As I said in my comment, one of your declarations is wrong and because of that, the unexpected result. Please, try understanding the next (didactic) code, to clarify the issue:
Sub testArray1D2D()
Dim arr1D, arr2DStrange, arr2D, i As Long
arr1D = Split("a,b,c,d,e,f,g,h,i,j", ",")
ReDim arr2DStrange(10, 1): ReDim arr2D(1 To 10, 1 To 1)
For i = 0 To UBound(arr1D)
arr2DStrange(i, 1) = arr1D(i)
arr2D(i + 1, 1) = arr1D(i)
Next i
Range("A2").Resize(UBound(arr2DStrange), 1).value = arr2DStrange 'it returns nothing
Range("B2").Resize(UBound(arr2DStrange), 2).value = arr2DStrange 'it returns what you need in the second column (D:D)
Range("D2").Resize(UBound(arr2D), 1).value = arr2D 'it returns correctly (what you need)
Range("E2").Resize(UBound(arr1D) + 1, 1).value = Application.Transpose(arr1D) 'also correct (a 1D array does not have any column! and it must be transposed. Otherwise, it repeats its first element value)
End Sub
When use declaration Dim test22(10, 1) As Integer it creates a 2D array but it has two columns. It is the equivalent of Dim test22(0 to 10, 0 to 1) As Integer. When you fill only the second column (1) and try returning the first one (0), this column, is empty.
The correct declaration for obtaining a 2D array with 10 rows and 1 column should be Dim test22(1 to 10, 1 to 1) As Integer.
Then, iTemp = CInt(UBound(dat1)) declares a 1D array of 11 elements (from 0, inclusive, to 10). And you never loaded its first element, starting iteration with 1. That's why the line Sheets("Info").Range("G1:G10").Value2 = NumMatches returned the first empty element 10 times... If your code would fill correctly the first element and if it was a matching one, your code will return 10 rows of 1 value.
NumMatches(iCompareOuter) = NumMatches(iCompareOuter) + 1 is the equivalent of NumMatches(iCompareOuter) = 1. NumMatches(iCompareOuter) is always empty in that moment...
And it is good to cultivate the habit to avoid declarations As Integer in such a case. Working with Excel rows, the value of an Integer must be exceeded. Try using As Long. VBA is so designed to make the memory working in the same way, without any supplementary stress.
A more compact way to accomplish what you need will be the next approach:
Sub Comparor()
Dim dat1(), dat2(), NumMatches(), mtch, i As Long
dat1() = Sheets("Data1").Range("E1:E10").Value2
dat2() = Sheets("Data2").Range("E1:E10").Value2
ReDim NumMatches(1 To UBound(dat1), 1 To 1)
For i = 1 To UBound(dat1)
mtch = Application.match(dat1(i, 1), dat2, 0)
If IsNumeric(mtch) Then NumMatches(i, 1) = "OK"
Next i
Sheets("Info").Range("G1:G10").Value2 = NumMatches
End Sub
Not tested, but it should work. Except the case of a typo, when an error will be raised and sending some feedback I will rapidly correct...
This for example
Dim test22(10, 1) As Integer
in the absence of Option Base 1 is the same as
Dim test22(0 to 10, 0 to 1) As Integer
I'd use
Dim test22(1 to 10, 1 to 1) As Integer
if you want to match the arrays you read from the worksheet. Otherwise, dropping those arrays to a range only gives you the first "column" (which are all zeros since you never assigned anything there...)
I have a code where I'm adding last rows to collection which should be later transformed to an array and final step is to get last row with the least number of cells in it.
My current code is:
Dim lastc, lastc2, lastr, FindColNumber, FindColNumber2 as Long
Dim FindCol as Range
Dim col As New Collection
Dim CollectionToArray As Variant
Set FindCol = 1 'example
FindColNumber = FindCol.Column
lastc = FindColNumber + 1
Set FindCol2 = 5 'example
FindColNumber = FindCol2.Column
lastc2 = FindColNumber - 1
For R = lastc2 To lastc Step -1
lastc2 = R
col.Add Cells(ws.Rows.count, R).End(xlUp).Row
Next R
Debug.Print WorksheetFunction.Min(CollectionToArray(col))
Public Function CollectionToArray(myCol As Collection) As Variant
Dim result As Variant
Dim cnt As Long
ReDim result(myCol.count - 1)
For cnt = 0 To myCol.count - 1
result(cnt) = myCol(cnt + 1)
Next cnt
CollectionToArray = result
End Function
I am still getting Type Mismatch error and when hovering over CollectionToArray(Col)) I see "Object variable or With block variable not set".
Thank you.
i foung similiar topic, but i can t apply completily that solution to my needs... I want to upgrade excel workbook at my job by making it more auto-entry capable.
Mostly i use excel functions, but sometimes i need some VBA coding, which im not very familiar with. So my problem is, that i need something like this mentioned on this thread. How to get the first and last numbers in a sequence
I have box numbers in different sequince in ascening order starting from "A4" to X on
Sheet1. Example Box numbers: M004935149,M004935150,M004935151,M004935202,M004935203,M004935204,M004935205, is it possible when i copy&paste(values) to sheet2 from "A4" to X (depenting on number of boxes copied) to make a string, sentence or whatever is called in specific form in some other cells. M004935149-151 // M004935202-205. I used code from topic in link above, it can make half job done but i can t figure it out how to make entry from desired cell range and display them on worksheet, and to display values in desired format. Link of screen shoots from my example is following:
I hope that someone can help. Thanks in advance.
Check this
Option Explicit
Sub test2()
Dim ws As Worksheet
Dim arr() As String, result As String, letter As String, cellValue As String, tempLastElement As String
Dim lastColumn As Long, counter As Long
Dim firstColumn As Integer, targetRow As Integer, i As Integer
Set ws = Worksheets("Sheet1")
firstColumn = 1 'number of first column with target data
targetRow = 1 'number of row with target data
lastColumn = ws.Range(ws.Cells(targetRow, firstColumn), ws.Cells(targetRow, Columns.Count).End(xlToLeft).Columns).Count
ReDim arr(1 To lastColumn - firstColumn + 1)
letter = Left(ws.Cells(targetRow, firstColumn).Value, 1) 'if count of character in start of string will be more 1, replace 1 on to count of characters
For i = 1 To UBound(arr)
cellValue = ws.Cells(targetRow, i).Value
arr(i) = Right(cellValue, Len(cellValue) - 1) 'if count of character in start of string will be more 1, replace 1 on to count of characters
Next i
ReDim sequenceArr(1 To UBound(arr))
sequenceArr(1) = arr(1)
counter = 2
For i = 1 To UBound(arr) - 1
If CLng(arr(i)) + 1 = CLng(arr(i + 1)) Then
tempLastElement = arr(i + 1)
sequenceArr(counter) = tempLastElement
Else
counter = counter + 1
sequenceArr(counter) = arr(i + 1)
counter = counter + 1
End If
Next
ReDim Preserve sequenceArr(1 To counter)
result = ""
counter = 1
For i = 1 To UBound(sequenceArr) - 1
If counter > UBound(sequenceArr) Then Exit For
If result = "" Then
result = letter & sequenceArr(counter) & "-" & Right(sequenceArr(counter + 1), 3)
counter = counter + 2
Else
result = result & "//" & letter & sequenceArr(counter) & "-" & Right(sequenceArr(counter + 1), 3)
counter = counter + 2
End If
Next
ws.Range("D4").Value = result
End Sub
Result on
I have run into a problem, im fairly new to VBA but learning fast. I have been trying to right this code below, to look through a column and pick out all the possible values that rows of data take in this column for use in another bit of code.
I cant get the array to work, i could just be doing it wrong.
In case its not clear, it should check the value of a cell in column I and if it is a value (and if it hasnt been stored already (code shown but not used yet)) then the value is stored in the array and the position in the array and the position down the column incremented.
Another question i havent looked at yet is then how to arrange the values in the array by name etc? The values in this case will be AHU1, AHU2, AHU3 etc up to about AHU5 or 6, I also intend to implent a bit of code that will expand the Array if necassery (from smaller so it is not bigger than it needs to be)
EDIT: another problem i havnt worked out yet is why the If statement always causes the value to be added to the array (which it doesnt)
Do
If IsNull(V1.Range("I" & i)) = False Then 'And V1.Range("I" & i).Value <> (Val(AHUArray(1)) Or Val(AHUArray(2)) Or Val(AHUArray(3)) Or Val(AHUArray(4)) Or Val(AHUArray(5)) Or Val(AHUArray(6)) Or Val(AHUArray(7)) Or Val(AHUArray(8)) Or Val(AHUArray(9)) Or Val(AHUArray(10))) Then 'And (does not equal any other values in the array
AHUArray(ArrayDim) = V1.Range("I" & i).Text
i = i + 1
ArrayDim = ArrayDim + 1
Else
i = i + 1
End If
Loop While i <= LastRow
Any ideas?, help will be greatly appreciated!
These are the definitions from before this code encase its a probloem with these (as it has been in the past but i dont think it is?
Dim V1 As Worksheet
Dim LastRow As Long
Dim C As Range
Dim FirstAddress As String
Dim AHUArray(1 To 10) As String
Dim DestCell As Integer
Dim i As Integer
Dim ArrayDim As Integer
Set V1 = ThisWorkbook.Sheets("V1")
Set AHU = ThisWorkbook.Sheets("AHU")
LastRow = V1.Range("A:A").Find("*", V1.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
DestCell = 3
ArrayDim = 1
i = 3
Change
IsNull(V1.Range("I" & i)) = False
to
V1.range("I" & i).value <> ""
When you use IsNull like that you are always going to get true, because you are asking, "is this range value which I just created and defined Null?"
Regarding dynamically growing the array, see this answer for examples on how to do so.
In the end this is how i managed it. Realised using IsNull was foolish, and managed to make a check function using how UBound returns -1 is it doesnt find anthing
Do
If IsEmpty(V1.Range("I" & i)) = False And IsInArray(V1.Range("I" & i).Value, AHUArray) = False Then '(does not equal any other values in the array
AHUArray(ArrayDim) = V1.Range("I" & i).Value
i = i + 1
ArrayDim = ArrayDim + 1
Else
i = i + 1
End If
Loop While i <= LastRow
and this is the other check function
Function ArrayCountIs(ArrayToCount As Variant) As Integer
Dim i As Integer
Dim ArrayCount As Integer
ArrayCount = 0
i = 0
For i = LBound(ArrayToCount) To UBound(ArrayToCount)
If Not (ArrayToCount(i)) = "" Then
ArrayCount = ArrayCount + 1
End If
Next
ArrayCountIs = ArrayCount
End Function
I'm trying to cumulate the sums of values in an excel column of 4 values dimension (4,1).
So, I constructed the code below. For the first row in a column on the side Result, it is supposed to hold the same value as in the original Array.
But then, once it is greater than the first row, it is supposed to get the previous element of result (i-1) and add to it the current column element (i).
VBA is telling me that the subscript is out of range :/ and I cant figure out why... so I dont even know if my code does what I want.
Sub CumulativeSum()
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
For i = 1 To 4
result(1) = rColumn(1, 1)
For j = 2 To 3
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Next i
Dim dest As Range
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = result
End Sub
Sub CumulativeSum()
Dim dest As Range
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
result(1) = rColumn(1, 1)
For j = 2 To 4
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = Application.Transpose(result)
End Sub
Don't have enough rep to add a comment but.. the reason why you're getting an error is because the Syntax for Cells is Cells([Row],[Column]). You're typing it in as Cells([Column],[Row]).
Try Range(Cells(1, 5), Cells(4, 5)) instead.