I've been struggling with this code here (probably very simple mistake), would anyone mind pointing out where my issues are? My overall goal is to allow this subroutine to accept a range of variable size, however I can't seem to get it to work for a fixed size.
If I manually allocate the array, things work as expected but when I allocate with a range that's where things go wrong. The output comes back untouched, which leads me to believe that I'm not doing something correctly with the allocation. Also I'm getting errors when I try to pass ws.UsedRange as oppose to a fixed range.
Private Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long)
Dim i As Long, j As Long, v As Long
For i = lo0 + 1 To hi0
v = a(i)
j = i
Do While j > lo0
If Not a(j - 1) > v Then Exit Do
a(j) = a(j - 1)
j = j - 1
Loop
a(j) = v
Next i
End Sub
Sub runSort()
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Dim myArr() As Variant
Dim rangeUse As Range
With ws.Range("D17:K17")
ReDim myArr(1 To 1, 1 To ws.Range("D17:K17").Columns.Count)
myArr = ws.Range("D17:K17").Value
End With
Call InsertionSort(myArr, LBound(myArr), UBound(myArr))
Range("D19:K19") = myArr
End Sub
Any help would be appreciated! TIA
So considerating you only want to sort your 2-dimensional array row by row, this might be a useful starting point. You can always change With ws.Range("A2:A3") to With Selection. If you do so, you have the Range you selected with your cursor.
With ws.Range("A2:A3")
myArr = .Value
For i = 1 To .Rows.Count
ReDim tmpArr(1 To .Columns.Count)
For j = 1 To .Columns.Count
tmpArr(j) = myArr(i, j)
Next j
Call InsertionSort(tmpArr, 1, .Columns.Count)
For j = 1 To .Columns.Count
myArr(i, j) = tmpArr(j)
Next j
Next i
.Offset(RowOffset:=10) = myArr
End With
Detailed Description
You don't have to redim myArray because if you set it to a range, it automatically scales.
tmpArr is each row of your range. If you select your range with the cursor some rows might be shorter or longer than others, thats why we redim that one. Edit This doesn't work just yet, because .Columns.Count refers to the whole range, not just the row. If you have different column counts then you'd have to change that.
For j = 1 To .Columns.Count
tmpArr(j) = myArr(i, j)
Next j
Unfortunately we cannot use tmpArr = myArr(i) because only one dimension of a multidimensional array cannot be accessed like this in VBA.
Call InsertionSort(tmpArr, 1, .Columns.Count) calles your Insertion Sort algorithm and sorts one row at a time.
After tmpArray got sorted, we have to set myArray(i) to the new values with the same loop we already used:
For j = 1 To .Columns.Count
myArr(i, j) = tmpArr(j)
Next j
Now we sorted all the rows in our Range, now we can put it back on the sheet, 10 rows beneath the first row of the specified range with .Offset(RowOffset:=10) = myArr
I hope that this helps you! While testing I saw that you might have a little bug in your InsertionSort algorithm. If the first value is the smalles, it just blindly gets copied into all the other fields of the array :)
Related
I'm very new at VBA I'm wanting to copy and transpose multiple columns and rows. Bonus if I can get alternating blank columns in between. I can get the first column to move but I'm stuck there. I'm assuming I can make a loop somehow? Here is what I'm trying to do for all data A1 to H12.
Thank you
Please, try the next code:
Sub ProcessRange()
Dim sh As Worksheet, arr, arrFin, i As Long, j As Long, r As Long, c As Long
Set sh = ActiveSheet
arr = sh.Range("B3:M10").value 'put the range to be processed in an array
ReDim arrFin(1 To UBound(arr) / 2, 1 To UBound(arr, 2) * 2) 'ReDim the array to keep the processing result
r = r + 1: c = c + 1 'initialize variables (r = rows, c = columns) for the final array
For j = 1 To UBound(arr, 2) 'iterate between the processed array columns
For i = 1 To UBound(arr) 'iterate between the processed array rows
If i Mod 2 = 1 Then
arrFin(r, c) = arr(i, j) 'extract the cases of odd rows
Else
arrFin(r, c + 1) = arr(i, j): r = r + 1 'extract the case of even rows and increment the row
End If
If i = UBound(arr) Then r = 1: c = c + 2 'reinitialize the row variable and increment the column one
Next i
Next j
'drop the processed array content at once:
sh.Range("B17").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin
End Sub
I make an exception, supposing that you, being new, do not understand the community spirit and rules and answer a question which cannot prove any effort to solve the problem by your own and show us a piece of code, even a not working one.
Please, learn that and ask questions only in the community spirit.
You must learn that we here only help you correct your not working solution.
I have a code that works as following:
Refresh a query that has roughly 10.000 rows.
Split the data in various 2D Arrays, depending on some criteria (I have in total a dozen different 2D Arrays).
Paste each 2D Array in a different sheet.
When I run the macro the first time it takes ~18 seconds, on the second run ~30 seconds, on the third run ~35 seconds, on the fourth run ~45 seconds and so on. The data from the query is exactly the same at every run (it doesn't change so frequently, or it can change of at most one or two lines).
Can somebody explain me if there are some kind of memory issues I'm not aware of? I also tried to set the matrix equal to Nothing after is pasted on the sheet but this didn't change the slowdown at every run. Any help would be appreciated.
P.S. the code is long and I feel it would be useless to paste it all here. It works more or less as follows:
Sub GetMatrix()
Dim Matrix As Variant, IndexMatrix As Long, i As Long, NoRows As Long
IndexMatrix = 0
ReDim Matrix(IndexMatrix, 2)
NoRows = Application.CountA(Range("A:A"))
For i = 2 To NoRows
If Cells(i, 1) = "Something" Then
Matrix(IndexMatrix, 0) = "Something"
Matrix(IndexMatrix, 1) = "Something"
Matrix(IndexMatrix, 2) = "Something"
IndexMatrix = IndexMatrix + 1
ReDim Preserve Matrix(IndexMatrix, 2)
End If
Next
GetMatrix = Matrix
End Sub
Try the next adapted function, please:
Function GetMatrix() As Variant
Dim sh As Worksheet, arr As Variant, Matrix As Variant
Dim IndexMatrix As Long, i As Long, LastRow As Long
Set sh = ActiveSheet
LastRow = sh.Range("A" & Rows.count).End(xlUp).Row
arr = sh.Range("A1:A" & LastRow).Value
ReDim Matrix(2, UBound(arr)) 'to admit redim preserve (only on the last dimension) at the end
For i = 2 To LastRow
If arr(i, 1) = "Something" Then
Matrix(0, IndexMatrix) = "Something"
Matrix(1, IndexMatrix) = "Something"
Matrix(2, IndexMatrix) = "Something"
IndexMatrix = IndexMatrix + 1
End If
Next
ReDim Preserve Matrix(2, IndexMatrix - 1)
GetMatrix = Matrix
End Function
I have 'for i = 1 to x' loop to fill columns however it is very slow.
I don't have enough knowledge of vba to know a different way.
Here is my code:
Dim j As Long
j = 6
For i = 4 To EFlast_row
If InStr(ef.Cells(i, ActualTitleColumn).Value, search.Cells(searchboxrow, searchboxcolumn).Value)Then
search.Cells(j, SearchLayerColumn).Value = ef.Cells(i, layercolumn).Value
j = j + 1
End If
Next i
Any help would be much appreciated.
Thank you
This code will put the data from sheets into a range variable. Comparisons using range variables are significantly quicker than using a reference like:
Sheets("Sheet1").Cells(1,1).Value
You will need to update this to reflect the variables you are using.
Function search()
' Put data on sheets into ranges
Dim rangeOne As Range, rangeTwo As Range
Set rangeOne = Sheets("Sheet1").UsedRange
Set rangeTwo = Sheets("Sheet2").UsedRange
' Iterands for rangeOne and rangeTwo respectively
Dim i As Long, j As Long
For i = 2 To rangeOne.Rows.Count
For j = 2 To rangeTwo.Rows.Count
If InStr(rangeOne(i, 1).Value2, rangeTwo(j, 1).Value2) Then
rangeTwo(j, 2).Value2 = rangeOne(i, 2).Value2
End If
Next j
Next i
End Function
I am doing some code to put a range into an array so i can create plots by analyzing the data inside that array. I am trying to use a general code for the range since the input can be different depending on the type of analysis i want to perform. Tried to find a solution for this in other questions without success.
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next
The return is a type mismatch error that i can't understand...
Here's one approach:
Function RangeTo1DArray(rngStart As Range)
Dim rv(), arr, r As Long, n As Long
'read the source data to an array for better performance
With rngStart.Parent
arr = .Range(rngStart, .Cells(Rows.Count, rngStart.Column).End(xlUp)).Value
End With
n = UBound(arr, 1)
ReDim rv(0 To n - 1)
'Fill the output array. Note: purposefully not using transpose()
' to avoid its limitations
For r = 1 To n
rv(r - 1) = arr(r, 1)
Next r
RangeTo1DArray= rv
End Function
Ok, i used the Redim and it worked just fine.
What i couldn't understand is that there's a need to set the correct size of an array to read/write data. I thought a simple Dim as Variant should be enough to store the data at my will without need to set a correct size each time i want to use an array.
The code after ReDim:
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
ReDim DieBankArray(A2 To last_row - 2)
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next
I am trying to find a way to:
Loop through a column (B column)
Take the values, store them in an array
Loop through that array and do some text manipulation
However, I cannot think of a way to loop through a column and take those values, storing them in an array. I have looked through Stack Overflow and google but have not found a successful solution.
In advance, thank you for your help.
Sub collectNums()
Dim eNumStorage() As String ' initial storage array to take values
Dim i as Integer
Dim j as Integer
Dim lrow As Integer
lrow = Cells(Rows.Count, "B").End(xlUp).Row ' The amount of stuff in the column
For i = lrow To 2 Step -1
If (Not IsEmpty(Cells(i, 2).Value)) Then ' checks to make sure the value isn't empty
i = eNumStorage ' I know this isn't right
Next i
If (IsEmpty(eNumStorage)) Then
MsgBox ("You did not enter an employee number for which to query our database. Quitting")
Exit Sub
End If
End Sub
This is the easiest way to get column to array:
Public Sub TestMe()
Dim myArray As Variant
Dim cnt As Long
myArray = Application.Transpose(Range("B1:B10"))
For cnt = LBound(myArray) To UBound(myArray)
myArray(cnt) = myArray(cnt) & "something"
Next cnt
For cnt = LBound(myArray) To UBound(myArray)
Debug.Print myArray(cnt)
Next cnt
End Sub
It takes the values from B1 to B10 in array and it gives possibility to add "something" to this array.
The Transpose() function takes the single column range and stores it as an array with one dimension. If the array was on a single row, then you would have needed a double transpose, to make it a single dimension array:
With Application
myArray = .Transpose(.Transpose(Range("A1:K1")))
End With
MSDN Transpose
CPearson Range To Array
Creating an Array from a Range in VBA
Just adding a variation on Vityata's which is the simplest way. This method will only add non-blank values to your array. When using your method you must declare the size of the array using Redim.
Sub collectNums()
Dim eNumStorage() As String ' initial storage array to take values
Dim i As Long
Dim j As Long
Dim lrow As Long
lrow = Cells(Rows.Count, "B").End(xlUp).Row ' The amount of stuff in the column
ReDim eNumStorage(1 To lrow - 1)
For i = lrow To 2 Step -1
If (Not IsEmpty(Cells(i, 2).Value)) Then ' checks to make sure the value isn't empty
j = j + 1
eNumStorage(j) = Cells(i, 2).Value
End If
Next i
ReDim Preserve eNumStorage(1 To j)
'Not sure what this bit is doing so have left as is
If (IsEmpty(eNumStorage)) Then
MsgBox ("You did not enter an employee number for which to query our database. Quitting")
Exit Sub
End If
For j = LBound(eNumStorage) To UBound(eNumStorage) ' loop through the previous array
eNumStorage(j) = Replace(eNumStorage(j), " ", "")
eNumStorage(j) = Replace(eNumStorage(j), ",", "")
Next j
End Sub