I am looking to loop through Column A.
- If the next number is greater than the previous number continue (A: 0,1,2,3..).
- Do this until the next number is equal or less than (A: 0,1,2,3,4,4..).
- If number is less than(A: 0,1,2,3,4,3..). or equal, take the highest # 4 subtract lowest #0, and put the results in columnB next to the highest number.
- If the next number is equal the previous number, subtract and put the answer 0 in columnB.
- If the next number is lower than the previous number continue. Do this until the next number is equal or less than.
- If number is less than or equal, take the highest # 4 subtract lowest #0...
I am not sure If I am clear but I am thinking a loop might work for this situation. Or perhaps any other idea would be greatly appreciated. Thanks in advance.
A B
1 0
2 1
3 2
4 3
5 4 4
6 4 0
7 3
8 2
9 1
10 0 4
11 1
12 2 2
13 2 0
14 3
15 4 2
... ...
You can use dictionary... adding the row number to the key value and check the positions...
Sub YourLoop()
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
Dim i As Integer
Dim n As Integer
For i = 1 To Rows.Count
''ColumnA values
dic.Add i, Cells(i, 1).Value
Next i
Dim k1 As Integer
Dim k2 As Integer
Dim k3 As Integer
Dim k4 As Integer
Dim v1 As Integer
Dim v2 As Integer
Dim v3 As Integer
Dim v4 As Integer
Dim v As Integer
Dim c As Integer
c = 1
For Each key In dic.Keys
v = dic(key)
If c = 1 Then
''do nothing
ElseIf c = 2 Then
k1 = key - 1
v1 = dic(k1)
If v <= v1 Then
End If
ElseIf c = 3 Then
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
ElseIf c >= 4 And c < dic.Count Then
k4 = key - 4
k3 = key - 3
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
v3 = dic(k3)
v4 = dic(k4)
ElseIf c = dic.Count Then
End If
c = c + 1
Next
Related
I need help separating responses from a survey into different columns. Each "check all that apply" question has the responses from each respondent in one cell (e.g. 1,3,4 or 1,2 or 2,4, etc.). For example, I want to create x number of columns for all the answer choices, then code the responses 'yes' or 'no' in excel.
Q2
1,2,3
2,3,4
3,4
1,3,4
1,2,4
...
I learned how to separate the column by comma using Text to column but this is the code after I separate it:
Q2
1 2 3
2 3 4
3 4
1 3 4
1 2 4
...
What I want is each column have a similar value per row. Here is an example :
Q2
1 2 3
2 3 4
3 4
1 3 4
1 2 4
...
Is there a way to do it without moving each cell manually since there is like 100 answer? Thanks
For Office 365 Insider Channel:
=LET(ζ,0+TEXTSPLIT(A1,","),XLOOKUP(SEQUENCE(,MAX(ζ)),ζ,ζ,""))
Copy down to get similar results for the strings in A2, A3, etc.
If you didn't have access to Office 365 insider, you could do a similar thing using Split in VBA:
Sub test()
Dim LString As String
Dim LArray() As String
' Change to Long for larger ranges (question only required 100 rows)
Dim i As Integer, j As Integer, k As Integer, lastElement As Integer, LR As Integer
Const LC = 5
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR
LString = Cells(i, 1)
LArray = Split(LString, ",")
lastElement = UBound(LArray, 1)
k = 0
For j = 1 To LC
If k > lastElement Then
Exit For
Else
If LArray(k) = j Then
Cells(i, j + 1) = LArray(k)
k = k + 1
End If
End If
Next j
Next i
End Sub
Assumes responses in each row are in ascending order and output range is initially blank.
I'm tring to write an Excel (2013) function that would take a 1x2n range of cells and return 1xn vector of cells that are of even/odd index. So if I put some numbers in cells A1:F1 as this
A
B
C
D
E
F
1
43
23
67
12
6
1
And put this function in A2:C2, it should return
A
B
C
D
E
F
1
43
23
67
12
6
1
2
23
12
1
I wrote something like this, but it doesn't work (#Arg! error)
Public Function Even(X As Variant) As Variant
Dim N As Integer
N = UBound(X)
ReDim Y(N / 2)
For i = 1 To N
If i Mod 2 = 0 Then
Y(i / 2) = X(i)
End If
Next i
Even = Y
End Function
After #BigBen comments I've changed the code to
Public Function Even(X As Variant) As Variant
Dim N As Integer
N = Application.CountA(X.Value)
ReDim Y(N / 2)
For i = 1 To N
If i Mod 2 = 0 Then
Y(i / 2) = X(i)
End If
Next i
Even = Y
End Function
It now returns almost what I want, it returns:
A
B
C
D
E
F
1
43
23
67
12
6
1
2
0
23
12
1
where's 0 coming from
Here is a possibility. EVEN is a spreadsheet function, so a different name is preferable. EveryOther seems natural, but with a name like that, why not make it flexible enough to select the odds if need be? A good way to do that is to make an optional Boolean argument which controls if even or odd indices are chosen:
Function EveryOther(Rng As Range, Optional Evens As Boolean = True) As Variant
Dim i As Long, j As Long, n As Long
Dim cell As Range
Dim returnVals As Variant
n = Rng.Cells.count
ReDim returnVals(1 To n)
i = 0
j = 0
For Each cell In Rng.Cells
i = i + 1
If i Mod 2 = IIf(Evens, 0, 1) Then
j = j + 1
returnVals(j) = cell.Value
End If
Next cell
ReDim Preserve returnVals(1 To j)
EveryOther = returnVals
End Function
I'm trying to learn how to do count-sorting in excel-vba using arrays. I'm having some issue with the final step of actually doing the count sort (v1Sort and V2 Sort columns). This is the table so far
V1 V2 Bin V1Count PointerV1 V2Count PointerV2 V1Sort V2Sort
6 3 -1 2 2 1 1 ? ?
7 2 0 3 5 4 5
1 6 1 4 9 4 9
5 3 2 5 14 5 14
6 0 3 2 16 2 16
9 7 4 4 20 2 18
7 9 5 4 24 4 22
8 6 6 2 26 4 26
2 4 7 4 30 1 27
8 3 8 1 31 2 29
4 2 9 0 31 2 31
1 3 10
2 6
0 10
1 5
8 7
5 9
5 10
5 1
6 7
3 2
8 5
0 6
2 8
3 1
2 3
4 4
3 1
3 7
3 1
6 2
Here's my code so far without actually doing the final step of the count sort. I understand the concept fully but am finding it hard to use arrays to do the count sort.
Sub Count_Sorting()
Const iOffData As Integer = 1
Const iOffPoint As Integer = 2
Const iOffPoint_2 As Integer = 3
Dim iBin As Integer
Dim iData As Integer
Dim iPointerVector_1() As Integer
Dim iPointerVector_2() As Integer
Dim iPoint As Integer
Dim iRow As Integer
Dim iDataVector_1(32) As Integer
Dim iDataVector_2(32) As Integer
Dim iSortVector_1(1 To 50) As Integer
Dim iSortVector_2(1 To 50) As Integer
Application.ScreenUpdating = True
Sheets("Sheet1").Range(Cells(1, 3), Cells(50, 8)).Clear
ReDim iPointerVector_1(-1 To 11)
ReDim iPointerVector_2(-1 To 11)
Sheets("sheet1").Cells(1, 1).Value = "V1"
Sheets("sheet1").Cells(1, 2).Value = "V2"
Sheets("sheet1").Cells(1, 3).Value = "Bin"
Sheets("sheet1").Cells(1, 4).Value = "V1Count"
Sheets("sheet1").Cells(1, 5).Value = "PointerV1"
Sheets("sheet1").Cells(1, 6).Value = "V2Count"
Sheets("sheet1").Cells(1, 7).Value = "PointerV2"
'Write bin numbers.
For iRow = 2 To 13
Sheets("Sheet1").Cells(iRow, 3).Value = iRow - iOffPoint_2
Next iRow
'Read the values from Sheet1.
For iRow = 2 To 32
iDataVector_1(iRow) = Sheets("Sheet1").Cells(iRow, 1).Value
iDataVector_2(iRow) = Sheets("Sheet1").Cells(iRow, 2).Value
Next iRow
'************************************************************
'First we do the procedure for sorting Vector 1
'************************************************************
'Count the number of data points in each bin for Vector 1 .
For iRow = 2 To 32
iPointerVector_1(iDataVector_1(iRow)) = iPointerVector_1(iDataVector_1(iRow)) + 1
Next iRow
For iBin = 0 To 10
Sheets("Sheet1").Cells(iBin + iOffPoint, 4).Value = iPointerVector_1(iBin)
Next iBin
'Get cumulative counts, located in prior bins, in preparation for later
're-reading of the data and decrementing of the pointers for Vector 1.
For iBin = 0 To 10
iPointerVector_1(iBin) = iPointerVector_1(iBin - 1) + iPointerVector_1(iBin)
Next iBin
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 5).Value = iPointerVector_1(iBin)
Next iBin
'
'************************************************************
'Now we do the procedure for sorting Vector 2
'************************************************************
'Count the number of data points in each bin for Vector 2.
For iRow = 2 To 32
iPointerVector_2(iDataVector_2(iRow)) = iPointerVector_2(iDataVector_2(iRow)) + 1
Next iRow
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 6).Value = iPointerVector_2(iBin)
Next iBin
'Get cumulative counts, located in prior bins, in preparation for later
're-reading of the data and decrementing of the pointers for Vector 2.
For iBin = 0 To 10
iPointerVector_2(iBin) = iPointerVector_2(iBin - 1) + iPointerVector_2(iBin)
Next iBin
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 7).Value = iPointerVector_2(iBin)
Next iBin
```End Sub
You indeed get the idea about count sorting. What makes your implementation difficult is the way you organize your code. Probably the first thing to do is to define a CountSort() function which takes as input an array of values, and returns an array of the same values sorted. Now, I see that you want to output the contents of intermediate arrays used in the count sort function to cells of Sheet1. So, you could pass to the CountSort() function the row and column indexes where to output intermediate arrays. So, your function could look like this:
' Returns array of the values sorted.
Public Function CountSort(values() As Integer, rowIndex As Integer, columnIndex As Integer) As Integer()
End Function
To output the contents of an array to Sheet1 you can define a routine like:
' Print contents of array values in column columnIndex, starting at rowIndex going downwards.
Sub PrintArray(values() As Integer, rowIndex As Integer, columnIndex As Integer)
Dim i As Integer
For i = 0 To UBound(values) - LBound(values)
Sheets("Sheet1").Cells(rowIndex + i, columnIndex).Value = values(LBound(values) + i)
Next
End Sub
And the CountSort() function would look like:
' Returns array of the values sorted.
Public Function CountSort(values() As Integer, rowIndex As Integer, columnIndex As Integer) As Integer()
' Assuming values are in range [0 10].
Dim bin(0 To 10) As Integer
Dim i As Integer
' Initialize bin to 0.
For i = LBound(bin) To UBound(bin)
bin(i) = 0
Next
PrintArray values, rowIndex, columnIndex
' Count number of occurrences of each value.
For i = LBound(values) To UBound(values)
bin(values(i)) = bin(values(i)) + 1
Next
PrintArray bin, rowIndex, columnIndex + 1
' Find cumulative frequency.
For i = LBound(bin) + 1 To UBound(bin)
bin(i) = bin(i) + bin(i - 1)
Next
PrintArray bin, rowIndex, columnIndex + 2
' Build sorted array.
Dim sorted() As Integer
ReDim sorted(LBound(values) To UBound(values)) As Integer
For i = UBound(values) To LBound(values) Step -1
sorted(bin(values(i))) = values(i)
bin(values(i)) = bin(values(i)) - 1
Next
PrintArray sorted, rowIndex, columnIndex + 3
' Return sorted array.
CountSort = sorted
End Function
In VBA, it is always a good idea to use the LBound() and UBound() functions as they make your code independent of how arrays have been declared index-wise.
I want to get this table:
C|O 1 2 3 Count
A 1 1 0 2
B 0 0 1 1
C 0 0 0 0
However, with the code I have been developing I get the following result. The number of columns and rows are dynamic.
C|O 1 2 3 Count
A 1 1 0 2
B
C
Here's the code. I think the first problem is on the countRange. And the second problem is when I put the count value, I want to do as initial values b = 0 and k = 1 as well I want to advance a = a + 1 and repeat the While cycle.
Dim a As Integer
a = 0
Dim b As Integer
b = 0
Dim k As Integer
k = 1
operations = 1
Do While operations <= sh1.Range("D4").Value + 1
If sh2.Cells(12,3+b) = "Count" Then
Dim countRange As Range
Set countRange = sh2.Range(Cells(13+a, 3),Cells(13+a,3+b-1))
Dim count As Integer
count = sh2.Application.WorksheetFunction.Sum(countRange)
sh2.Cells(13+a,3+b) = count
a = a + 1
b = 0
k = 1
Else
If sh2.Cells(12+a,3+b) = operations Then
If sh2.Cells(13+a,2) = arrayC(k) Then
sh2.Cells(13+a,3+b).Value = 1
Else
sh2.Cells(13+a,3+b).Value = 0
End If
End If
operations = operations + 1
b = b + 1
k = k + 1
End If
Wend
Declare the operations variable as Dim operations as Integer = 1 and use while loop. the Do....While loop surely executes at least for single time.
I am looking for a way to repeat a set of cells horizontally a certain number of times before moving on to the next set of cells. For example:
If I have this in 3 columns:
5 4 3
0 1 2
and I have 3 columns which dictate how many times I want the values iterated:
4 2 3
This function should give me this when dragged over a range:
5 5 5 5 4 4 3 3 3
0 0 0 0 1 1 2 2 2
Does anyone know the best manner to do this?
I have been using some convoluted reasoning to get through this with an array formula ( has the "{}" brackets around it and you have to use Shift+Enter). I am using SUMIF and COUNTIF functions to do some things, but it never really works out.
Here's a hacky VBA solution. This assumes the "repeat counts" are on the first row (4, 2, 3) and the "values to repeat" are on the second row (5, 4, 3, 0, 1, 2).
Sub outputRepeatedValues()
Dim xStart As Integer, yStart As Integer
Dim i As Integer, j As Integer
Dim valueToRepeat As Integer, numTimesRepeat As Integer
Dim xOffset As Integer, yOffset As Integer
xStart = ActiveCell.Column
yStart = ActiveCell.Row
i = 1
j = 1
xOffset = 0
yOffset = 0
While Cells(2, j) <> ""
If Cells(1, i) = "" Then
i = 1
yOffset = yOffset + 1
xOffset = 0
End If
numTimesRepeat = Cells(1, i)
valueToRepeat = Cells(2, j)
For k = 1 To numTimesRepeat
Cells(yStart + yOffset, xStart + xOffset) = valueToRepeat
xOffset = xOffset + 1
Next k
j = j + 1
i = i + 1
Wend
End Sub
Stick this in a new module. To use this code, select the cell representing the upper left corner of the output region. Then press Alt+F8 to bring up the Macro box, and then you can run the macro.