Microsoft Office Forums - View Single Post - Nested Looping all combinations of four items

lhoffmeyer · 11-30-2012, 03:09 PM

I finally found a solution
I created a summaryarray for the four elements (A,B,C,D)
I then took each of the header rows (AB,AC,AD,BC,BD,CD) and broke the header into ITEM1, ITEM2 (i.e. AB ITEM1=A, ITEM2=B)
If the test value > 1.645 then
Match ITEM2 to an array element
Take Item1 and copy Item2 into it's summary cell
If the test value < -1.645 then
Match ITEM1 to an array element
Take Item2 and copy Item1 into it's summary cell

I am posting the syntax I created even though it won't work on the example I provided earlier because
I am doing much more than this one item such as using multiple test result rows and variable number of
items (more than just A,B,C,D).
I hope it provides a good starting point if anyone else wants to perform a similar operation.
Lance

Code:

NumColumns=4 
NextColSeries = 0 
NumPropRows = 1 
BaseRow = 1 
StartTestCol = 6 
StartCol = 1 
LastCol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column 
LastCol = LastCol + 2 
 
 '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''
 ' CREATE SUMMARY
 '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''
LastCol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column 
LastCol = LastCol + 2 
Dim SummaryArray() As Variant 
ReDim SummaryArray(1 To NumColumns) 
For i = 1 To NumColumns 
    SummaryArray(i) = Cells(1, StartCol + i - 1) 
Next i 
For intIndex = LBound(SummaryArray) To UBound(SummaryArray) 
    strBuff = strBuff & "Index " & intIndex & " = " & SummaryArray(intIndex) & vbLf 
Next 
For i = 1 To NumColumns 
    Cells(BaseRow, LastCol + i) = Cells(1, i + 1) 
Next i 
For PRows = 1 To NumPropRows 
    For A = 1 To NumColumns 
        For B = 1 To (NumColumns - A) 
            item1 = Mid(Cells(BaseRow, NextColSeries + StartTestCol + (B - A)), 1, 1) 
            item2 = Mid(Cells(BaseRow, NextColSeries + StartTestCol + (B - A)), 2, 2) 
            If Cells(BaseRow + PRows, NextColSeries + StartTestCol + (B - A)) >= 1.645 Then 
                For i = 1 To NumColumns 
                    If item2 Like SummaryArray(i) Then item2Index = i 
                Next i 
                For ii = 1 To NumColumns 
                    If item1 Like SummaryArray(ii) Then Cells(BaseRow + PRows, LastCol + ii).Value = Cells(BaseRow + PRows, LastCol + ii).Value & SummaryArray(item2Index) 
                Next ii 
            End If 
             
            If Cells(BaseRow + PRows, NextColSeries + StartTestCol + (B - A)) <= -1.645 Then 
                For i = 1 To NumColumns 
                    If item1 Like SummaryArray(i) Then item1Index = i 
                Next i 
                For ii = 1 To NumColumns 
                    If item2 Like SummaryArray(ii) Then Cells(BaseRow + PRows, LastCol + ii).Value = SummaryArray(item1Index) & Cells(BaseRow + PRows, LastCol + ii).Value 
                Next ii 
            End If 
             
        Next B 
        NextColSeries = NextColSeries + (NumColumns - A + 1) 
    Next A 
    NextColSeries = 0 
Next PRows