classification of grouped items based on parent child hierarchy - excel

I have several thousands of lines with parent-child hierarchies and a sample I am sharing here. The data has hierarchy levels starting from 0 to 10, but for me from level 3 and above are important as I am calculating the weight of parent level 3 which is dependant on it's child and sub child levels.
From column L to P, I have shown the hierarchy, where 3 is the parent, 4 is child and some childs 4 are then classified to 5,6,7... so on. The weight of parent 3 is sum of all 4's, where sum of 4's is again sum of 5's and so on..
I tried to initially write the parent info. of each child by putting here in C7 the following formula =IF(B7>3;IF(B7>B6;D6;C6);"")
which works fine till row 6 and then fails as the level here changes from 6 to 5. See the image below
So I realised that Excel formula will not be sufficient here to extract all the parent info. Also cell F6 is again classified based on material are again dependent on child.
could anyone please tell how to proceed with vba for extracting the parent info. and the weight classification? A few lines of code would be a great help for me to head start.
Thanks a lot in advance!

Please, test the next code. You did not answer my clarification question and the following code assumes that you did not show us the correct weight for second 5:
Sub CalculateWeight()
Dim sh As Worksheet, lastR As Long, arr, arrC, ref As Long, i As Long, j As Long, k As Long
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
arr = sh.Range("B3:D" & lastR).Value 'put the range to be processed in an array, for faster iterations
ReDim arrC(1 To UBound(arr), 1 To 1) 'redim the final array for the same number of rows like arr
For i = 1 To UBound(arr) 'iterate between the array rows
If arr(i, 1) > 3 Then 'if the hierarchy value is > 3:
Do While (arr(i + j, 1) > 3)'loop until the next 0
ref = i - 1 'memorize the row keeping the third hierarchy
If arr(i + j, 1) = arr(i + j - 1, 1) + 1 Then 'if the value in column 1 is less with a unit thay precedent
arrC(i + j, 1) = arr(i + j - 1, 3): j = j + 1 'take the value of the precedent row, third column
Else
For k = i + j To ref Step -1 'iterate backwards
If arr(i + j, 1) = arr(k - 1, 1) + 1 Then 'when find the hierarchy less with a unit
arrC(i + j, 1) = arr(k - 1, 3): j = j + 1: Exit For 'take the value of third column and exit iteration
End If
Next k
End If
If i + j > UBound(arr) Then Exit For 'exit iteration if it exceeds the array number of elements
Loop
Else
arrC(i, 1) = "" 'for lines before each 3
End If
If j > 0 Then i = i + j - 1: j = 0 'reinitialize variables
Next i
sh.Range("C3").Resize(UBound(arrC), 1).Value = arrC 'drop the array content at once
End Sub

Related

Can't write array to sheet

Dim HighScoreOneHourData() As Integer
Dim HighScoreOneHourDates() As String
ReDim HighScoreOneHourData(1 To UBound(SA, 1) - 3)
ReDim HighScoreOneHourDates(1 To UBound(SA, 1) - 3)
For j = 4 To UBound(SA, 1)
HighScoreOneHourData(j - 3) = CInt(Val(SA(j, PositionInArray + DataColumn + 2)))
HighScoreOneHourDates(j - 3) = SA(j, 1)
Next j
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates)) = HighScoreOneHourDates
SortSheet.Range("B1:B" & UBound(HighScoreOneHourData)) = HighScoreOneHourData
When these last two lines in the example above are executed all the cells in the sheets are filled with the first element from the arrays.
HighScoreOneHourDates is an array filled with consecutive dates. Still only the first date is printed to the sheet.
I've stopped the code and checked the state of the arrays and the they are correctly filled.
Anyone knows why the cells are filled with the first element?
It's been explained why 1D arrays don't work for you. A better fix is to Dim them as 2D
ReDim HighScoreOneHourData(1 To UBound(SA, 1), 1 To 1) As Integer
ReDim HighScoreOneHourDates(1 To UBound(SA, 1), 1 To 1) As String
For j = 4 To UBound(SA, 1)
HighScoreOneHourData(j - 3, 1) = CInt(Val(SA(j, PositionInArray + DataColumn + 2)))
HighScoreOneHourDates(j - 3, i) = SA(j, 1)
Next j
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates, 1)) = HighScoreOneHourDates
SortSheet.Range("B1:B" & UBound(HighScoreOneHourData, 1)) = HighScoreOneHourData
A 1D array always wants to be placed on a sheet in a row, not a column. That's why you only get the first element repeated. You need to re-orient the array to put it in a column, or make your arrays 2D (1 To numHere, 1 To 1)
Note there is a limit to the array size you can pass to Transpose of around 63-64k elements.
Assuming your arrays are 1-based you can do this:
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates)) = _
Application.Transpose(HighScoreOneHourDates)
for example.

Trying breakup group data and sort them according to respective columns

I'm quite new to VBA. For each group shown below, I am trying to sort this data into a table where I can see if the student has been a part of a certain group or not. I have screenshotted the table where I am starting at, and the the second screenshot shows the table that I am trying to populate. If the student has been in the group or not, I want the table to write "exists" where the student has been a group member of.
Here's where the data that I am starting with.
Here's the table for which that I am trying to populate:
Please, try the next code:
Sub extractStudGroups()
'The code needs a reference to 'Microsoft Scripting Runtime'.
Dim sh As Worksheet, lastR As Long, arr, arrSt, El, dict As New scripting.Dictionary
Dim arrGr, arrKey, arr1, arrFin, i As Long, j As Long, k As Long, mtch
Set sh = ActiveSheet 'use here the necessary sheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row (calculated for colum B:B)
arr = sh.Range("B4:C" & lastR).value 'put the range to be processed in an array (works faster)
For i = 1 To UBound(arr) 'iterate between the array rows number:
arrSt = Split(arr(i, 2), vbLf) 'split the cells content on the line separator
For Each El In arrSt 'iterate between the splited array elements:
If Not dict.Exists(El) Then 'put the array elements in a dictionary (as unique keys)
dict.Add El, arr(i, 1) 'the item is the value in array col 1 (Group 1, 2, 3...)
Else
dict(El) = dict(El) & "|" & arr(i, 1) 'add to the key value the other Groups, separated by "|"
End If
Next El
Next i
arr1 = Application.Index(arr, 0, 1) 'make a slice of the fist array column
ReDim arrFin(1 To dict.count + 1, 1 To UBound(arr1) + 2): k = 2 'redim the final array (to keep the processed result)
arrFin(1, UBound(arr1) + 2) = "Order" 'Create a helper (last) column to sort ascending according to the right number in Student (1, 2, 3...)
For i = 1 To UBound(arr1) 'put the groups in the array (like headers), starting from the second column
arrFin(1, i + 1) = arr1(i, 1)
Next i
For i = 0 To dict.count - 1 'terate between dictionary keys/items:
arrFin(k, 1) = dict.Keys(i): arrFin(k, UBound(arr1) + 2) = Right(dict.Keys(i), Len(dict.Keys(i)) - 7) 'dict key in column 1 and numeric part in the last column
arrSt = Split(dict.items(i), "|") 'split by "|" (extract Group1, 2, 3...) to create an array
For Each El In arrSt 'iterate betwen groups of a specific student groups:
mtch = Application.match(El, arr1, 0) 'if the specific group is found in the dictionary item array
If IsNumeric(mtch) Then arrFin(k, mtch + 1) = "exists" '"exists" is writen in the appropriate column
Next
k = k + 1 'increment the final array row to be filled with data
Next i
'drop the final array content at once, sort by last (helper) column and delete the helper column:
With sh.Range("F2").Resize(UBound(arrFin), UBound(arrFin, 2))
.value = arrFin
.Sort Key1:=.cells(1, UBound(arr1) + 2), Order1:=xlAscending, Header:=xlYes
.cells(1, UBound(arr1) + 2).EntireColumn.Delete
End With
End Sub
I tried commenting the code lines to make it easier to be understood.
Please, send some feedback after testing it.
You can easily do this with a formula:
=IF(ISNUMBER(SEARCH(D15,$C$4)), "exists", "not exists")
In the above formula SEARCH will return a number if the text is found, and the IF will return "exists". Create a formula for each column and copy it down. You will need to replace D15 with the real column since you don't show the column/row in you example.

Reach a number with a given array as choosing only big numbers among it [closed]

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 1 year ago.
Improve this question
In Excel or Excel Macro, I am trying to figure out an alghorithm/formula to reach a number with using highest ones as possible but there are some limitations. Let me explain with an example;
Let's say I have 5 numbers in 5 cells (line by line) to use (2,5,10,20,50) and I need to reach 98.
In this example, I should only use 50 + 20 + 20 + 5 + 2 + 2. Even if I can't reach exact number (like reaching 98), it should be the results with minimum exceeds (like 99). It can't be lower than the target number.
I will copy these rows (as fetching their numbers in their first column) and paste to another sheet from the list. Please think these numbers to select rows, so I could find the appropriate rows as finding the right algorithm / formula for it.
How about this:
Put your data for example (2,5,10,20,50) into A1:A5 at the top of sheet1.
Put the below code into a vba code module, and run Algorithm.
I wrote the result into column C, but modify as needed.
Sub Algorithm()
Dim Tgt As Double, currVal As Double
Dim iRow As Integer, oRow As Integer 'input and output row
Dim ary, sortedAry 'input arrays
Dim aResult(1 To 100, 1 To 1) 'assuming result is less than 100 rows long
Tgt = 98 'Target number
ary = Sheet1.Range("A1").CurrentRegion 'put data into an array
sortedAry = BubbleSort(ary, False) 'sort in descending order
iRow = 1
oRow = 1
currVal = 0
Do Until iRow > UBound(sortedAry)
If currVal + sortedAry(iRow, 1) > Tgt Then
iRow = iRow + 1 'goto next smallest number
Else
aResult(oRow, 1) = sortedAry(iRow, 1)
currVal = currVal + sortedAry(iRow, 1)
oRow = oRow + 1
End If
Loop
'one more so it goes over Tgt
aResult(oRow, 1) = sortedAry(UBound(sortedAry), 1)
'put results back into spreadsheet
Sheet1.Range("C1").Resize(100, 1) = aResult
End Sub
Function BubbleSort(myArray As Variant, Optional Ascending = True)
'suitable to sort a small list that is in a 1 column array
Dim i As Long, j As Long
Dim Temp As Variant
If Ascending = True Then
For i = LBound(myArray, 1) To UBound(myArray, 1) - 1
For j = i + 1 To UBound(myArray)
If myArray(i, 1) > myArray(j, 1) Then
Temp = myArray(j, 1)
myArray(j, 1) = myArray(i, 1)
myArray(i, 1) = Temp
End If
Next j
Next i
Else
For i = LBound(myArray, 1) To UBound(myArray, 1) - 1
For j = i + 1 To UBound(myArray)
If myArray(i, 1) < myArray(j, 1) Then
Temp = myArray(j, 1)
myArray(j, 1) = myArray(i, 1)
myArray(i, 1) = Temp
End If
Next j
Next i
End If
BubbleSort = myArray
End Function

Excel index match with a condition to choose a specific column in a 3d matrix (formula or VBA)

I have two tables in Excel, one with categories and listings, and another with points based on the category and listing threshold. It goes as follows:
Categories table:
ID
CATEGORY
LISTINGS
Points
001
A
56
002
C
120
003
A
4
004
B
98
Points table:
Category
tier1
tier2
tier3
A
Tier 1
Tier 2
Tier 3
Range
1-30
31-90
91-
Points
10
20
30
B
Tier 1
Tier 2
Tier 3
Range
1-25
26-100
101-
Points
10
20
30
C
Tier 1
Tier 2
Tier 3
Range
1-40
41-80
81-
Points
10
20
30
I started with an INDEX MATCH formula pointing at the points:
=INDEX(Points!A1:D11, MATCH(Categories!B2, Points!A1:A11, 0)+2)
--> the +2 is to get the points directly
I also though of evaluating the thresholds with this formula:
=IF(Categories!C2 >= NUMBERVALUE(LEFT(Points!D3, FIND("-",Points!D3)-1)),Points!D4, IF(Categories!C2 >=NUMBERVALUE(LEFT(Points!C3, FIND("-",Points!C3)-1)),Points!C4, Points!B4))
I thought that the else if the if would make it faster.
Could someone help me populate the Points column in the Categories table? VBA code is also acceptable. The tables are in different sheets.
José, your original Match formula is the right starting place. It locates the particular sub-table to do a further lookup on. But in order to make this formula a whole lot simpler, can we change the ranges (1-30, 31-90, 91-) to have just their starting points (1, 31, 91)? If we do that simple change then we can use the approximate lookup feature of HLookup to easily and compactly specify the Lookup:
=HLookup($C2,Offset(Points!$A$1,Match($B2,Points!$A:$A,0),1,2,3),2,True)
In the middle of this formula you can see your original Match function to locate the correct sub-table based on the category. We need to feed that start point to OFFSET() to create a table range useful to the HLookup. Offset takes an anchor cell reference (top left of the Points table), number of rows to count down from there (result of the Match), number of columns to the right (1), the number of rows in the range (2), and the number of columns in the range (3).
The Hlookup is just like a VLookup, but for tables arranged left-to-right not top-to-bottom. The True as the last parameter is very important as it tells HLookup to use the range lookup instead of an exact match.
A slightly verbose formula which takes the data as originally formatted (using Excel 365 Let):
=LET(ranges,INDEX(Points!B$2:D$12,MATCH(B2,Points!A$1:A$12,0),0),
leftRanges,VALUE(LEFT(ranges,FIND("-",ranges)-1)),
points,INDEX(Points!B$2:D$12,MATCH(B2,Points!A$1:A$12,0)+1,0),
INDEX(points,MATCH(C2,leftRanges)))
As it's urgent this is what I got but I cannot continue before tomorrow. Assuming you can at least put the tiers next to the category (A on same line as tiers) this will get you the first tier. You just need to copy the whole formula in the "nextCol", with minor modifications to get the next tiers.
if you really cannot change the source you need to add an additional offset in the first match.
=IF(AND(D1>NUMBERVALUE(LEFT(INDIRECT("B"&MATCH(E1,A:A,0)),FIND("-",INDIRECT("B"&MATCH(E1,A:A,0)))-1)),D1<NUMBERVALUE(RIGHT(INDIRECT("B"&MATCH(E1,A:A,0)),2))),INDEX(B:D,MATCH(E1,A:A,0)+1,1),"nextCol")
Option Explicit
Sub Score()
Dim wsP As Worksheet, wsC As Worksheet, dict
Dim iLastRow As Long, r As Long, i As Long, j As Integer
Dim sCat As String, iListing As Integer
Dim data, ar
Set wsP = Sheets("Points")
Set wsC = Sheets("Categories")
Set dict = CreateObject("Scripting.Dictionary")
iLastRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row
data = wsC.Range("A1:D" & iLastRow).Value2
' category to row lookup
For i = 1 To UBound(data)
If data(i, 1) = "Range" Then
dict.Add Trim(data(i - 1, 1)), i ' range
End If
Next
' scan points
iLastRow = wsP.Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To iLastRow
sCat = Trim(wsP.Cells(r, "B"))
iListing = wsP.Cells(r, "C")
If dict.exists(sCat) Then
i = dict(sCat)
For j = 4 To 2 Step -1
ar = Split(data(i, j), "-") ' lower-upper limit
If iListing >= ar(0) Then ' check lower limit
' update points
wsP.Cells(r, "D") = data(i + 1, j) ' points
Exit For
End If
Next
Else
MsgBox "No match '" & sCat & "'", vbCritical, "ERROR row " & r
End If
Next
MsgBox "done"
End Sub
Please, try the next code. It uses arrays and should be very fast, working only in memory. Please use your sheets when setting shC and shP as your real sheets. I only use the active sheet and the next one for testing reason:
Sub GetPoints()
Dim shC As Worksheet, shP As Worksheet, lastRC As Long, lastRP As Long, arrBC, arrP, arrPP, arrFin
Dim i As Long, j As Long, p As Long, k As Long
Set shC = ActiveSheet 'use here your Categories sheet
Set shP = shC.Next 'use here your Points sheet
lastRC = shC.Range("A" & shC.rows.count).End(xlUp).row
lastRP = shP.Range("A" & shP.rows.count).End(xlUp).row
arrBC = shC.Range("B2:C" & lastRC).Value 'put the range B:C in an array
arrP = shP.Range("A2:D" & lastRP).Value 'put all the range in an array
ReDim arrFin(1 To UBound(arrBC), 1 To 1) 'redim the array to keep processed values
For i = 1 To UBound(arrBC) 'iterate between Categ array elements:
For j = 1 To UBound(arrP) 'iterate between Points array elements:
If arrP(j, 1) = arrBC(i, 1) Then 'if Category is found:
For p = 2 To 4 'iterate between the next array row elements
arrPP = Split(arrP(j + 1, p), "-") 'split the element by "-" to determine the interval
If arrPP(1) <> "" Then 'for the tier3 case:
If arrBC(i, 2) >= CLng(arrPP(0)) And arrBC(i, 2) <= CLng(arrPP(1)) Then
k = k + 1
arrFin(k, 1) = arrP(j + 2, p): j = j + 2: Exit For 'place the value in the final array and exit iteration
End If
Else 'for the tier1 and tier2 cases:
If arrBC(i, 2) >= CLng(arrPP(0)) Then
k = k + 1
arrFin(k, 1) = arrP(j + 2, p): j = j + 2: Exit For 'place the value in the final array and exit iteration
End If
End If
Next p
End If
Next j
Next i
'drop the final array result at once:
shC.Range("D2").Resize(UBound(arrFin), 1).Value = arrFin
End Sub

Excel VBA macro for enumerating the combinations of r elements out of N elements

The original code in Box 1 and the code in Box 2 are published on this Q&A site . But, originally written in Japanese, so I translated to English with minor modifications. Both of them seems to be intended to enumerating the combinations of r elements out of N elements. However, I don't understand the principle behind the Box1's code.
My question
How can the Box1's macro list all the combinations that choose r elements from among N elements? I want to know mathematical principles of Box1's code.
I understand the principle of Box2's code.
Note 1: The logic of the Box2 code is as follows;
Each number below 2^N-1 is written in binary notation.
Consider the bits corresponding to 2^i to be the i-th element.
Consider the i-th element as chosen if it is 1 and not chosen if it is 0.
Thus, any combination of that "selects n "or less" elements" are listed.
Only those with exactly k number of 1's are left.
Simply, Box2's logic is a logic such that only the sets which satisfies the following condition survive;
Condition: "Number of elements whose bit=1" is r.
The code in Box 1 seems to export essentially the same results, but with fewer calculations.
Actually, after much experimentation, export of the Box1's code and Box2's code are essentially same. For example, Table 1 below shows the output for N = 5 and r = 3 . It displays 0 for the elements we don't choose and 1 for the elements we do choose.
But why can the code in Box 1 output the Essentially equivalent results to Box2's code?
Table1.A list of combinations, such that choosing 3 elements out of 5 elements
You can download XLSM file having both Box1's and Box2's macro from here.
Box1.
Sub Cmb()
Dim n, r, m, i, j, c(), o()
n = 5 'Please specify the N
r = 3 'Please specify the r
m = WorksheetFunction.Combin(n, r)
ReDim c(r), o(m, n)
For j = 0 To r: c(j) = j: Next
o(0, 0) = "Decimal"
For j = 1 To n: o(0, j) = "Elements" & j: Next
i = 1
Do While c(0) <= 0
For j = 0 To n: o(i, j) = 0: Next
For j = 1 To r
o(i, 0) = o(i, 0) + 2 ^ (c(j) - 1)
o(i, n + 1 - c(j)) = 1
Next
i = i + 1
nc n, r, c
Loop
Cells(1, 1).Resize(m + 1, n + 1).Value = o
End Sub
Sub nc(n, r, ByRef c())
Dim j, k
For j = r To 0 Step -1
c(j) = c(j) + 1
For k = j + 1 To r: c(k) = c(k - 1) + 1: Next
If c(j) <= n - r + j Then Exit For
Next
End Sub
Box2.
Sub enumeration_of_combinations()
Dim table_()
n = 5
r = 3
Number_of_elements = WorksheetFunction.Combin(n, r)
ReDim table_(1 To Number_of_elements)
cnt = 1
Nmax = (2 ^ n) - 1
For i = 1 To Nmax
Number_of_bits = 0: modulo_ = i
For j = 0 To n
Quotient_ = modulo_ \ 2 ^ (n - j)
modulo_ = modulo_ Mod 2 ^ (n - j)
Number_of_bits = Number_of_bits + Quotient_
Next j
If Number_of_bits = r Then
table_(cnt) = i: cnt = cnt + 1
End If
Next i
For i = 1 To Number_of_elements
modulo_ = table_(i)
For j = 0 To n
Quotient_ = modulo_ \ 2 ^ (n - j)
modulo_ = modulo_ Mod 2 ^ (n - j)
Cells(i + 1, j + 1) = Quotient_
Next j
Cells(i + 1, 1) = table_(i)
Next i
Cells(1, 1) = "Decimal": For j = 1 To n: Cells(1, j + 1) = "element" & j: Next j
End Sub
Reference.
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14208784379 (Written in Japanese)
This is what you should do:
break all those single-line For-Next cycle to make them easily readable by you;
rename all the variables with name made of multiple letters (at least 3 each) that has some sense according to the use the code make of them. To determine it, search for them in the code and interpret it;
if the purpose of one variable is not clear, try with another one;
if you still can't figure the purpose of some of the variables, use the immediate and local window while stopping the code during its execution. With this code you can also run the code once to have the result on sheet and re-run and stop it.
write the appropriate notes.
You should end with something like this:
Sub SubCombinations()
'Declarations.
Dim TotalBits, PositiveBits, CombinationsCount, Counter01, Counter02, ExponentsArray(), ResultArray()
'Setting variables.
TotalBits = 5 'Please specify the N
PositiveBits = 3 'Please specify the r
CombinationsCount = WorksheetFunction.Combin(TotalBits, PositiveBits)
'Reallocating variables.
ReDim ExponentsArray(PositiveBits), ResultArray(CombinationsCount, TotalBits)
'Setting the starting position of the ExponentsArray. This will result in the first line having all the 1 on the right.
For Counter02 = 0 To PositiveBits
ExponentsArray(Counter02) = Counter02
Next
'Setting the headers.
ResultArray(0, 0) = "Decimal"
For Counter02 = 1 To TotalBits
ResultArray(0, Counter02) = "Elements" & Counter02
Next
'Setting variable.
Counter01 = 1
'When ExponentsArray(0) will be greater than 0, we will have covered all possible combinations.
Do While ExponentsArray(0) <= 0
'Set all the bits in the given result row as 0.
For Counter02 = 0 To TotalBits
ResultArray(Counter01, Counter02) = 0
Next
'Covering all the positive bits requested for the row.
For Counter02 = 1 To PositiveBits
'Increasing the decimal result by 2 elevated by the power of the value of attributed to the given bit.
ResultArray(Counter01, 0) = ResultArray(Counter01, 0) + 2 ^ (ExponentsArray(Counter02) - 1)
'Reporting the positive bit in its proper location on the row.
ResultArray(Counter01, TotalBits + 1 - ExponentsArray(Counter02)) = 1
Next
'Setting Counter01 to cover the next row.
Counter01 = Counter01 + 1
'Calling SubExponentsShift
SubExponentsShift TotalBits, PositiveBits, ExponentsArray
Loop
'Reporting the results.
Cells(1, 1).Resize(CombinationsCount + 1, TotalBits + 1).Value = ResultArray
End Sub
Sub SubExponentsShift(TotalBits, PositiveBits, ByRef ExponentsArray())
'Declarations.
Dim Counter01, Counter02
'Covering all the values in the ExponentsArray.
For Counter01 = PositiveBits To 0 Step -1
'Increasing the exponent value. This will make "the given bit shift to the left".
ExponentsArray(Counter01) = ExponentsArray(Counter01) + 1
'If we have "shifted" a bit that was not the first on the right, we have to correct the overshoot of the other bit "shifted" previously.
For Counter02 = Counter01 + 1 To PositiveBits
ExponentsArray(Counter02) = ExponentsArray(Counter02 - 1) + 1
Next
'If we have overshoot while "shifting the position" of the given bit, the For-Next cycle continues.
If ExponentsArray(Counter01) <= TotalBits - PositiveBits + Counter01 Then
Exit For
End If
Next
End Sub
It will then be easier to realize how the code works. The subroutine actually sets the starting conditions and produce each row of the result while the function focuses on "shifting the position" of the bits for each row of the result. Matematically speaking, the code just increase metodically the exponents of given set of powers of 2 whose result are then sum; this goes on until all the unique combinations are covered.

Resources