I have the below code that adds values to an array if it meets a criteria.
It keeps looping horizontally through the columns across a row and then repeats the same for the next row and so on.
I am trying to clear the values accumulated in the array and empty it at the end of the columns loop:
For a = 21 To 23
Count = 0
For b = 2 To 36
If Not Worksheets("Sheet1").Cells(a, b).Value = "A" And Not Worksheets("Sheet1").Cells(a, b).Value = "B" Then
Count = Count + 1
Else
If Not Count = 0 Then
Dim arr() As Long
arrLen = 1
ReDim Preserve arr(1 To arrLen)
arr(arrLen) = Count
arrLen = arrLen + 1
For i = LBound(arr) To UBound(arr)
msg = msg & arr(i) & vbNewLine
Next i
Count = 0
End If
End If
Next b
MsgBox Worksheets("Sheet1").Cells(a, 1).Value & vbNewLine & msg
Erase arr 'not working
Next a
As you can see from the above code, I get a msgbox displaying the values at the end of each loop, however as it continues, the array keeps getting bigger and bigger indicating that the Erase line is not working.
Kindly help!
You can either use a loop to set the array elements to nulls, or ReDim the array away:
Sub marine()
Dim arr()
ReDim arr(1 To 2)
arr(1) = "Alpha"
arr(2) = "Beta"
ReDim arr(1 To 1)
arr(1) = ""
End Sub
That way you can re-use the same array name later in the sub.
Related
This code creates an array off a range.
When I try to see if the array is saving the elements, by using Debug.Print, nothing is shown in the Immediate Window. It displays blank spaces. There are no errors.
This only happens in that part of the code, the first Debug.Print line works. I do have data in the columns.
Dim myArray() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
If IsEmpty(Range("B3").Value) = True Then
ReDim myArray(0, 0)
Else
iCountLI = Sheets("Sheet1").Range("B3").End(xlDown).Row
iCountLI = (Range("B3").End(xlDown).Row) - 2
Debug.Print iCountLI
ReDim myArray(iCountLI)
For iElementLI = 1 To iCountLI
myArray(iElementLI - 1) = Cells(iElementLI + 2, 2).Value
Debug.Print myArray(iElementLI)
Next iElementLI
End If
Immediate problem: ReDim myArray(iCountLI) creates an array with empty values. In the For Loop, myArray(iElementLI - 1) = Cells(iElementLI + 2, 2).Value overwrites the first, second, etc. values, yet your Debug.Print myArray(iElementLI) is printing the second, third, etc. values. These, of course, haven't yet been overwritten, so they are still empty. The easiest fix, then, is to use Debug.Print myArray(iElementLI - 1).
More generally, I think you might be misunderstanding the meaning of ReDim myArray(iCountLI). Let's assume we have values in B3:B7. This would lead to ReDim myArray(5) in your code, but this is an array with 6 empty values, at location 0,1,2,3,4,5. This means you will keep an empty value trailing in the array after your loop, which is probably not what you want.
Here's a suggested rewrite with some comments:
Sub FillArray()
Dim myArray() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
'let's assume: B3:B7 with values: 1,2,3,4,5
If IsEmpty(Range("B3").Value) = True Then
ReDim myArray(0, 0)
Else
'iCountLI = Sheets("Sheet1").Range("B3").End(xlDown).Row
'this line serves no purpose: you are immediately reassigning the value in the next line
'iCountLI = (Range("B3").End(xlDown).Row) - 2 'This would be 5,
'but myArray(5) would have SIX elements
iCountLI = (Range("B3").End(xlDown).Row) - 3
Debug.Print iCountLI '4
ReDim myArray(iCountLI)
'For iElementLI = 1 To iCountLI
For iElementLI = 0 To iCountLI '0 to 4
myArray(iElementLI) = Cells(iElementLI + 3, 2).Value 'starting at 0, so "+3", not "+2"
'myArray(iElementLI - 1) = Cells(iElementLI + 2, 2).Value
Debug.Print myArray(iElementLI) 'in succession: 1,2,3,4,5
Next iElementLI
End If
End Sub
Finally, it is worth pointing out that you don't actually need a For Loop to populate an array with values from a range. You could use something as follows:
Sub FillArrayAlt()
Dim myArray() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
Dim myRange As Range
'let's assume: B3:B7 with values: 1,2,3,4,5
If IsEmpty(Range("B3").Value) = True Then
ReDim myArray(0, 0)
Else
Set myRange = Range("B3:" & Range("B3").End(xlDown).Address)
myArray = Application.Transpose(myRange.Value)
'N.B. Confusingly, used in this way, your array WILL start at 1!
For i = LBound(myArray) To UBound(myArray)
Debug.Print i; ":"; myArray(i)
' 1 : 1
' 2 : 2
' 3 : 3
' 4 : 4
' 5 : 5
Next i
End If
End Sub
You are valuing myArray(iElementLI -1) and printing myArray(iElementLI), which is still empty.
I had an dynamic array where is value is from the worksheet.
If condition is meet, I would like to delete the element that meet the condition. The code was from this post but it is returning
Type Mismatch
on ReDim Preserve arr(Len(arr) - 1)
Sub arrtest()
Dim arr As Variant
Dim i As Integer
ReDim arr(1 To 1)
Dim cnt As Long
cnt = 0
For i = 1 To Cells(Rows.Count, "L").End(xlUp).Row
If Cells(i, "A").Value = "-2" Then
cnt = cnt + 1
ReDim Preserve arr(1 To cnt)
arr(cnt) = Cells(i, "A").Value
End If
Next i
For i = 1 To cnt
Debug.Print "This is arr: "; arr(i)
If arr(i) = "TEST" Then
Call DeleteElementAt(i, arr)
Debug.Print "This is new arr: "; arr(i)
Else
Debug.Print "Nothing is deleted"
End If
Next
End Sub
Public Sub DeleteElementAt(ByVal index As Integer, ByRef arr As Variant)
Dim i As Integer
' Move all element back one position
For i = index + 1 To UBound(arr)
arr(i - 1) = arr(i)
Next
' Shrink the array by one, removing the last one
ReDim Preserve arr(Len(arr) - 1)
End Sub
The Len (or Length) of an array is its Upper Boundary. To decrease the size of the array by 1,
ReDim Preserve arr(UBound(arr) - 1)
Conversely, the beginning of an array is the LBound or lower boundary. This is usually 0 (zero) or 1 (one) and in a two-dimensioned array you can specify the rank.
I have a pre-determined array. Lets call it arr={"ok","okay","k"}
Now i have a worksheet with column headers as Fine, Great, okay, excellent
I want to find the column occurrence and select that column.
In this example, since "okay" matches, the answer should be 3
For i = 1 To Lastc
if sh.Cells(1,i)=?array? then ColSel = i
Here, Lastc is the last column in the sheet
sh is the worksheet where I am checking
ColSel will store the index number of the column where it was a match in the array
?array? is not correct. I am not sure what to insert here
You could flip it round, and loop through the elements of arr instead:
For Each el In arr
If Not IsError(Application.Match(el, Range(Cells(1, 1), Cells(1, LastC)), 0)) Then
ColSel = Application.Match(el, Range(Cells(1, 1), Cells(1, LastC)), 0)
End If
Next el
As far as I know, VBA does not have some function, that searches in array for a particular value. You can do it by yourself by looping through every value in your array. This solution works fine for me:
Sub test()
Dim arr(2) As String
Dim Lastc As Integer
arr(0) = "ok"
arr(1) = "okay"
arr(2) = "k"
Lastc = 4
Set sh = Sheets("Arkusz2")
For i = 1 To Lastc
For j = 0 To UBound(arr)
If sh.Cells(1, i) = arr(j) Then
MsgBox "The answer is: " & i
End
End If
Next j
Next i
End Sub
Slight variation on other answers to search the array with one loop.
Sub x()
Dim arr, i As Long, j As Long, colsel As Long
arr = Array("ok", "okay", "k")
For i = 1 To 4
If IsNumeric(Application.Match(Cells(1, i), Application.Index(arr, 1, 0), 0)) Then
colsel = i
Exit For
End If
Next
End Sub
Sub Test()
arr = Array("A", "B", "C")
For i = 1 To Lastc
For j = 0 To UBound(arr)
If Sh.Cells(1, i) = arr(j) Then
ColSel = i
Exit For
End If
Next
Next
End Sub
I am using the following code to chop up a column of comma-separated lists and to return each entry in a new row:
Sub SliceNDice()
'
' Splits the locations cells according to commas and pushes to new rows
' Code courtesy of brettdj (http://stackoverflow.com/questions/8560718/split-comma-separated-entries-to-new-rows)
'
Dim objRegex As Object
Dim x
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
'Define the range to be analysed
x = Range([a1], Cells(Rows.Count, "c").End(xlUp)).Value2
ReDim Y(1 To 3, 1 To 1000)
For lngRow = 1 To UBound(x, 1)
'Split each string by ","
tempArr = Split(x(lngRow, 3), ",")
For Each strArr In tempArr
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = x(lngRow, 1)
Y(2, lngCnt) = x(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
Next
Next lngRow
'Dump the re-ordered range to columns E:G
[e1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)
End Sub
While this code works perfectly, it has a fatal flaw in that any double-commas in the cells of column C will result in blank cells pushed to the new rows in column G.
Does anyone know how to edit the code so that it does not create new rows with empty cells in column G, but skips them and enters the next rows in their places as if the superfluous commas were never included in column C at all?
Just test for the string length of strArr as the first operation inside the For Each strArr In tempArr loop.
For Each strArr In tempArr
If CBool(Len(strArr)) Then
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = x(lngRow, 1)
Y(2, lngCnt) = x(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
End If
Next strArr
You could loop on the occurence of double comma to clean up the input as opposed to fixing the output, here is a working example:
Text in A1: Hello,,World,This,,Is,,,,,,,A,,Test
Sub TestString()
Dim MyString As String
MyString = Range("A1").Text
Do Until Len(MyString) = Len(Replace(MyString, ",,", ","))
MyString = Replace(MyString, ",,", ",")
Loop
MsgBox MyString
End Sub
You would do this just before splitting
If you want it as a function (would be better in your case) do this:
Function FixDoubleComma(MyString As String)
Do Until Len(MyString) = Len(Replace(MyString, ",,", ","))
MyString = Replace(MyString, ",,", ",")
Loop
FixDoubleComma = MyString
End Function
Then replace this in your code:
tempArr = Split(x(lngRow, 3), ",")
With this:
tempArr = Split(FixDoubleComma(x(lngRow, 3)), ",")
I have a little sample that solves blanks everywhere
Sub RemoveBlanks()
Dim mystr As String
Dim arrWithBlanks() As String
Dim arrNoBlanks() As String
Dim i As Integer
mystr = ",tom,jerry, ,,spike,," 'Blanks everywhere (beginning, middle and end)
arrWithBlanks = Split(mystr, ",")
ReDim arrNoBlanks(0 To 0)
Debug.Print "Array with blanks:"
'Loop through the array with blanks
For i = LBound(arrWithBlanks) To UBound(arrWithBlanks)
'Check if there is a blank (or element with spaces only)
If Trim(arrWithBlanks(i)) = "" Then
Debug.Print i & " (blank)"
Else
Debug.Print i & " " & arrWithBlanks(i)
If arrNoBlanks(UBound(arrNoBlanks)) <> "" Then ReDim Preserve arrNoBlanks(0 To UBound(arrNoBlanks) + 1)
arrNoBlanks(UBound(arrNoBlanks)) = arrWithBlanks(i)
End If
Next i
Debug.Print "Array with NO blanks:"
For i = LBound(arrNoBlanks) To UBound(arrNoBlanks)
Debug.Print i & " " & arrNoBlanks(i)
Next i
End Sub
Everything will be displayed in the immediate window (Press Ctrl + G to show it)
The result will look like this:
Array with blanks:
0 (blank)
1 tom
2 jerry
3 (blank)
4 (blank)
5 spike
6 (blank)
7 (blank)
Array with NO blanks:
0 tom
1 jerry
2 spike
I'm working on a VBA code in which I'm inserting Integer values:
Dim IgnoreCol() As Integer
For j = 1 To LastCol
If Cells(1, j).Value = "IGNORE" Then
ReDim Preserve IgnoreCol(Temp)
IgnoreCol(Temp) = j
Temp = Temp + 1
End If
Next
After this part of the code, I have in my program an Int array of column numbers - now, in the next loop I would like to approach the array:
For j = 1 To LastCol
If Not IsInArray(j, IgnoreCol) Then
DataLine = DataLine + Trim(Cells(Row, j).Value)
End If
Next j
So now I have 2 questions:
Say that neither of the columns in the sheet had "IGNORE" in their first cell and that my array "IgnoreCol" is empty, and none of the cells were initialized - what condition returns "True" if the array is really empty?
I'm using this code inside another loop - which means, I want to initialize my "IgnoreCol" array at the end of this code before entering it again (by initializing I mean delete all, not just put 0 in all of the cells for instance)
Thank you very much!
This would test for an empty array:
Function ArrayIsEmpty(a) As Boolean
Dim temp
On Error Resume Next
temp = LBound(a)
If Err.Number <> 0 Then ArrayIsEmpty = True
End Function
Use the Erase function to clear the array:
Dim a() As Integer
If ArrayIsEmpty(a) Then Debug.Print "Array starts empty" Else Debug.Print "Array NOT empty???"
Redim a(1 To 100)
If ArrayIsEmpty(a) Then Debug.Print "Array empty" Else Debug.Print "Array NOT empty"
Erase a
If ArrayIsEmpty(a) Then Debug.Print "Array NOW empty" Else Debug.Print "Array still not empty"
But I'd prefer to use a Dictionary object (from the "Microsoft Scripting Runtime", which you can add using "Tools...References" in the VBA editor).
Dim IgnoreCols As New Dictionary
For j = 1 To LastCol
If Cells(1, j).Value = "IGNORE" Then
IgnoreCols.Add j, 1
End If
Next
For j = 1 To LastCol
If Not IgnoreCols.Exists(j) Then
DataLine = DataLine + Trim(Cells(Row, j).Value)
End If
Next j
... or even better, something like this:
Dim IncludeCols As New Dictionary
For j = 1 To LastCol
If Cells(1, j).Value <> "IGNORE" Then
IncludeCols.Add j, 1 ' store the cols we *want*
End If
Next
' now just loop through the list of wanted cols
For j = 0 To IncludeCols.Count
DataLine = DataLine + Trim(Cells(Row, IncludeCols.Keys(j)).Value)
Next j