I'm using the =Filter() function to produce a dynamic array that I am referencing in another cell. Where the output is of the format: example1
However, I'd like to return the array in the format: example2 with a gap before each record where the "type" changes.
I've tried using a helper column and using an IF statement to enter a blank if the previous record had a different value in column A, and then concatenating the cell reference using the =COUNTBLANK() function to refer to correct record. However, this resulted in a different number of blank rows depending on the order of column A.
Is there a better way of achieving this result?
Thanks,
-L.
First put this User Defined Function in a standard module:
Option Explicit
Public Function separate(rng As Range)
Dim arr
arr = rng
Dim U As Long, i As Long, j As Long
Dim L As Long
arr = rng
U = UBound(arr, 1)
L = LBound(arr, 1)
ReDim arrbig(1 To U * 2, 1 To 2)
j = 2
arrbig(1, 1) = arr(1, 1)
arrbig(1, 2) = arr(1, 2)
For i = 2 To U
If arr(i, 1) <> arr(i - 1, 1) Then
arrbig(j, 1) = ""
arrbig(j, 2) = ""
j = j + 1
End If
arrbig(j, 1) = arr(i, 1)
arrbig(j, 2) = arr(i, 2)
j = j + 1
Next i
j = j - 1
ReDim temp(1 To j, 1 To 2)
For i = 1 To j
temp(i, 1) = arrbig(i, 1)
temp(i, 2) = arrbig(i, 2)
Next i
separate = temp
End Function
If we start with raw data in cols A and B like:
We create a dynamic array in cols D and E by putting:
=FILTER(A1:B15,(A1:A15<>"junk")*(A1:A15<>"Peaches"),"X")
in D1:
We create the formatted array in cols G and H by putting this formula in G1:
=separate(D1#)
Related
I have the following code throwing a Type MisMatch Error on the line highlighted below. The code is supposed to simply identify empty elements in the input array (stat5) and replace them with a single period in the output array (ArrayOut). However, when it encounters the empty element in position (9,2) of stat5, it throws the Type MisMatch error:
From what I have read about the Type MisMatch error, it sounds like data assigned to a variable does not match the type of the variable. However, in my case, I am encountering the error EVEN when I attempt to simply call the value of stat5(9,1) in the Debug.Print statement below. It hangs on the Print statement (which is not an assignment statement, so I can't figure out what is mismatching with what):
Here is the code:
ReDim ArrayOut(1 To X1N, 1 To 1)
For i2 = 1 To X1N
If Len(Trim(stat5(i2, 2))) = 0 Then
ArrayOut(i2, 1) = "."
Else
ArrayOut(i2, 1) = stat5(i2, 2)
End If
Next i2
Here is the data in the input array (In this particular case, the non-missing values of the 2nd column of the array are constant, but this is not always the case). These are the values of stat5 when the error occurs in iteration 9 of the loop:
1 0.500285714
2 0.500285714
3 0.500285714
4 0.500285714
5 0.500285714
6 0.500285714
7 0.500285714
8 0.500285714
9
10 0.500285714
=========================================================
Here is the code that sets up stat5. All of this code runs without error:
Dim stat1 As Variant
Dim stat2 As Variant
Dim stat3 As Variant
Dim stat4 As Variant
Dim stat5 As Variant
'ReCombine Results for Final Printing
'Add ObsNum to each
'Prediction Set Results
ReDim stat1(1 To X3N, 1 To 2)
For i2 = 1 To X3N
stat1(i2, 1) = X3(i2, 1)
If Pred = True Then
If NumberOfArrayDimensions(ArrayPredIn) = 1 Then
stat1(i2, 2) = ArrayPredIn(i2)
Else
stat1(i2, 2) = ArrayPredIn(i2, 1)
End If
Else
stat1(i2, 2) = ""
End If
Next i2
'Estimation Set ResultS
ReDim stat2(1 To UBound(X4, 1), 1 To 2)
If NumberOfArrayDimensions(ArrayEstIn) = 1 Then
For i2 = 1 To UBound(X5, 1)
stat2(i2, 1) = X4(i2, 1)
stat2(i2, 2) = ArrayEstIn(i2)
Next i2
Else
For i2 = 1 To UBound(X5, 1)
stat2(i2, 1) = X4(i2, 1)
stat2(i2, 2) = ArrayEstIn(i2, 1)
Next i2
End If
'Concatenate stat1, stat2, stat3
ReDim stat5(1 To X1N, 1 To 2)
stat5 = Combine(stat1, stat2)
QuickSortArray stat5, , , 1
Here is the Combine function:
Function Combine(a As Variant, b As Variant, Optional stacked As Boolean = True) As Variant
'assumes that A and B are 2-dimensional variant arrays
'if stacked is true then A is placed on top of B
'in this case the number of rows must be the same,
'otherwise they are placed side by side A|B
'in which case the number of columns are the same
'LBound can be anything but is assumed to be
'the same for A and B (in both dimensions)
'False is returned if a clash
Dim lb As Long, m_A As Long, n_A As Long
Dim m_B As Long, n_B As Long
Dim m As Long, N As Long
Dim C As Variant
If TypeName(a) = "Range" Then a = a.value
If TypeName(b) = "Range" Then b = b.value
lb = LBound(a, 1)
m_A = UBound(a, 1)
n_A = UBound(a, 2)
m_B = UBound(b, 1)
n_B = UBound(b, 2)
If stacked Then
m = m_A + m_B + 1 - lb
N = n_A
If n_B <> N Then
Combine = False
Exit Function
End If
Else
m = m_A
If m_B <> m Then
Combine = False
Exit Function
End If
N = n_A + n_B + 1 - lb
End If
ReDim C(lb To m, lb To N)
For i = lb To m
For j = lb To N
If stacked Then
If i <= m_A Then
C(i, j) = a(i, j)
Else
C(i, j) = b(lb + i - m_A - 1, j)
End If
Else
If j <= n_A Then
C(i, j) = a(i, j)
Else
C(i, j) = b(i, lb + j - n_A - 1)
End If
End If
Next j
Next i
Combine = C
End Function
=========================================================================
UPDATE: When I check the type of each element of stat5, the type of element (9,2) is 8204 (while all the other (i2,2) elements are 5 = vbdouble). However, I'm not sure what this means: Has a multi-element array been saved to the (9,2) element of the array stat5? Is that possible?
I tried wrapping all of the calls to stat5(i2,2) with CStr(), hoping to convert the info in (9,2) to a string, but this also gives the same Type MisMatch error.
Locals window output:
===============================================================================
Results from the Locals window:
However, the variable type according to VarType() for elements (1-8,2) is vbDouble ("5") which seems to contradict the results in the Locals window:
===============================================================================
UPDATE: I was able to reproduce the error with stat1 BEFORE the Combine function was used to create stat5. Therefore, I do not believe that the problem is with the Combine function.
I'm trying to populate part of an array with 0's and wondering if there was a better way then to loop through it.
I know I could use Dim tempArr as double to do this but the first column in the array contains strings.
I'm currently using
Dim tempArr as Variant
ReDim tempArr(1 To 6, 1 To 1 + (EndWeek - (BeginWeek - 1)))
tempArr(1, 1) = "Monday - Friday"
tempArr(2, 1) = "Saturday"
tempArr(3, 1) = "Sunday"
tempArr(4, 1) = "Bank Holiday"
tempArr(5, 1) = "Annual Leave"
tempArr(6, 1) = "Apprentice"
For i = 1 To 6
For j = 2 To UBound(tempArr, 2)
tempArr(i, j) = CDbl(0)
Next j
Next i
But surely there's a better way?
I'm have 2 issues with the function I had created. First is the bubble sort on 2 cols on a 2d array(Decending sort - 2nd col first, then 1st col) . I believe I've implemented this correct, but the results tend to differ.
Input
COL 1 COL 2
35.484% 38.296%
1.075% 0.112%
1.075% 0.056%
48.387% 0.124%
1.075% 0.005%
2.151% 0.051%
2.151% 0.006%
2.151% 0.002%
3.226% 0.003%
1.075% 0.032%
1.075% 0.184%
1.075% 0.263%
Output
35.484% 38.296%
48.387% 0.124%
1.075% 0.112%
2.151% 0.051%
2.151% 0.006%
1.075% 0.056%
3.226% 0.003%
1.075% 0.005%
1.075% 0.032%
1.075% 0.184%
2.151% 0.002%
1.075% 0.263%
You can see immediately, the last line of the output should have been at somewhere in the higher order.
And I'm unable to output the entire array to a range. No error is shown, the function simply exits. I appreciate any help in this. The code is shown below and thanks again.
Function larger(range1 As Range, range2 As Range)
Dim Q() As Variant
Dim x As Range, y As Range
Dim i As Integer, j As Integer
Dim varTemp(1 To 2) As Variant
Q = Range(range1.address, range2.address)
ReDim Q(1 To UBound(Q, 1), 1 To UBound(Q, 2))
j = 1
i = 1
While i < UBound(Q, 1)
For Each x In range1
While j < UBound(Q, 2)
Q(i, j) = x
j = j + 1
Q(i, j) = range2(i)
Wend
i = i + 1
j = 1
Next
Wend
' Bubble sort - first with the 2nd col and then the 1st col
'2nd col
For i = LBound(Q) To UBound(Q) - 1
If Q(i, 2) < Q(i + 1, 2) Then
For j = 1 To 2
varTemp(j) = Q(i, j)
Q(i, j) = Q(i + 1, j)
Q(i + 1, j) = varTemp(j)
Next j
End If
Next
'1st col
For i = LBound(Q) To UBound(Q) - 1
If Q(i, 1) < Q(i + 1, 1) Then
For j = 1 To 2
varTemp(j) = Q(i, j)
Q(i, j) = Q(i + 1, j)
Q(i + 1, j) = varTemp(j)
Next j
End If
Next
j = 1
For i = LBound(Q, 1) To UBound(Q, 1)
MsgBox (Q(i, j) & " " & Q(i, j + 1))
Next
MsgBox ("end")
Range("P3:Q14") = Q 'Not writing entire queue into specified range
End Function
First of all, in order to sort a range, it's easiest to use Excel's build in Sort method! Thus, try this method:
Sub SortRange(rng As Range)
rng.Sort rng.Resize(, 1).Offset(, 1), xlAscending, rng.Resize(, 1)
End Sub
You can call it like this: SortRange Range("A1:B12")
In case you want to sort it yourself to cater for some specialties, here's the bubble sort:
Sub Sort(rng As Range)
Dim varValues As Variant
Dim i As Long, j As Long
varValues = rng.Cells
For i = 1 To UBound(varValues, 1)
For j = i + 1 To UBound(varValues, 1)
Select Case varValues(i, 2)
Case Is > varValues(j, 2): subSwap varValues, i, j
Case varValues(j, 2):
If varValues(i, 1) > varValues(j, 1) Then subSwap varValues, i, j
End Select
Next j
Next i
rng.Cells = varValues
End Sub
Private Sub subSwap(varValues As Variant, i As Long, j As Long)
Dim varTemp As Variant
Dim k As Long
For k = 1 To UBound(varValues, 2)
varTemp = varValues(i, k)
varValues(i, k) = varValues(j, k)
varValues(j, k) = varTemp
Next
End Sub
Looking at your code, I noticed a few things (that's why I remade from scratch instead of "fixing" yours):
Instead of Range(range1.address, range2.address) you can use Range(range1, range2), or event better, declare it as a full range (e.g. Range("A1:B12")` directly. Also, using range1.Resize(,2) will resize to a two column range
Your whole first loop seems a bit redundant and probably wrong (at least you always assign the value from range1 to all columns). Normally, you can assign a full range to an array using varArray = YourRange.Cells. No need to redim.
In your bubble sort, you need to nest the check for the column to be checked second in the first loop. Else, you can get wrong results when the column to be checked first has more the 2 rows with the same value
When assigning an array back to a range, better assign to Range.Cells. Also, make sure that the range has the same dimension.
Last but not least, you make your sub flexible, i.e. allow any parameter - but then assign the result to a hard-coded range. This will fail the moment you call it with some other range - or your workbook structure changes! Better flexibilize this, too (e.g. using `Range("NamedRangeName").Resize(UBound(Q, 1), UBound(Q,2)).Cells = Q
Just out of curiosity ,I am asking you a question which is as below:
Suppose i do have an array A1(6)=(45,25,,36,88),A2(6)=(14,25,11),A3(6)=(11,21,20,25,48).Now can we put those array values with the help of a single statement like single array assignment to a row,as here all the rows to a range of an Excel, Say here "C1:R3" range.
EDIT
If I need to assign them to a row like R1<- A1 + A2 +A3,R2<- A1 + A2 +A3. Can you tell me how to this?
R1<- (45,25,,36,88),14,25,11,,,,11,21,20,25,48,) same for R2.
Thanks,
Dim A(2,5)
For i = 0 to 5
A(0, i) = A1(i)
A(1, i) = A2(i)
A(2, i) = A3(i)
Next i
Range("C1:R3").Value = A
EDIT
For second part, to the best of my understanding:
Dim R(17)
For i = 0 To 2
For j = 0 To 5
R(6 * i + j) = A(i, j)
Next j
Next i
Range("C5:T5").Value = R
EDIT 2
Alternatively:
Dim R
R = Split(Join(A1, ",") & "," & Join(A2, ",") & "," & Join(A3, ","), ",")
Range("C5:T5").Value = R
You can use any delimiter you like (if it's appropriate for your data).
I have data stored in some column (Say, Column A). The length of Column A is not fixed (depends on previous steps in the code).
I need a histogram for the values in Column A, and have it in the same sheet. I need to take the values in column A, and automatically compute M Bins, then give the plot.
I looked online for a "simple" code, but all codes are really fancy, with tons of details that I don't need, to the extent that I am not even able to use it. (I am a VBA beginner.)
I found the following code that seems to do the job, but I am having trouble even calling the function. Besides, it only does computations but does not make the plot.
Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single
For i = 1 To M
freq(i) = 0
Next i
Length = (arr(UBound(arr)) - arr(1)) / M
For i = 1 To M
breaks(i) = arr(1) + Length * i
Next i
For i = 1 To UBound(arr)
If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
For j = 2 To M - 1
If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
Next j
Next i
For i = 1 To M
Cells(i, 1) = breaks(i)
Cells(i, 2) = freq(i)
Next i
End Sub
And then I try to call it simply by:
Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range
arr = Range("A1:A10").Value
M = 10
Hist(M, arr) ' This does not work. Gives me Error (= Expected)
End Sub
A little late but still I want to share my solution. I created a Histogram function which might be used as array formula in the excel spread sheet. Note: you must press
CTRL+SHIFT+ENTER to enter the formula into your workbook. Input is the range of values and the number M of bins for the histogram. The output range must have M rows and two columns. One column for the bin value and one column for the bin frequency.
Option Explicit
Option Base 1
Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
Dim val() As Variant
val = arr.Value
Dim i As Long, j As Integer
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Integer
Dim min As Single
min = WorksheetFunction.min(val)
Dim max As Single
max = WorksheetFunction.max(val)
Length = (max - min) / M
For i = 1 To M
breaks(i) = min + Length * i
freq(i) = 0
Next i
For i = 1 To UBound(val)
If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
If val(i, 1) > breaks(M) Then
freq(M) = freq(M) + 1
Else
j = Int((val(i, 1) - min) / Length) + 1
freq(j) = freq(j) + 1
End If
End If
Next i
Dim res() As Variant
ReDim res(M, 2)
For i = 1 To M
res(i, 1) = breaks(i)
res(i, 2) = freq(i)
Next i
Histogram = res
ErrHandler:
'Debug.Print Err.Description
End Function
Not 100% sure as to the efficacy of that approach but;
Remove the parens as your calling a sub; Hist M, arr
M is declared as double but received by the function as a long; this won't work so declare it in the calling routine as long
You will need to recieve arr() As Variant
Range -> Array produces a 2 dimensional array so the elements are arr(1, 1) .. arr(n, 1)