Nested Looping all combinations of four items

lhoffmeyer · #1 11-30-2012, 08:13 AM

Hello

I have four cells (A,B,C,D) and I am testing all cells against each other.
So, I am testing AB, AC, AD, BC, BD, CD
In columns 1-6 I have the test results. (see below)
In columns 11-14 I wish to create a summery for A, B, C, D

I am looking for any results greater than the absolute value of
1.5. If the result is positive then it indicates that the first item in the
test is greater than the second item A > B, for AB, if the result
is negative then it indicates the second item in the test is greater
than the first item, B > A for AB

So, in the example below
A > B
B > D
C > AD
D > A

So, what I need to do is create a (nested) loop that will go through these
six columns of test results and create 4 summary columns.

Any help is much appreciated,

TIA,

Lance

Here is the summary I would like to create
C11 C12 C13 C14
R1 A B C D
R2 B D AD A

Header and Intial test results for A B C D

R1 AB AC AD BC BD CD
R2 1.6 -1.6 -1.6 0 1.6 1.6

lhoffmeyer · #2 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Separate the digits into 3 combinations	Jasa P	Word VBA	1	08-19-2012 11:04 PM
numbered nested list	giocarmine	Word	1	01-22-2012 11:19 AM
Nested IFs	JimS378	Excel	7	05-03-2011 08:20 PM
Outlook 2007 Saved sent items list only holds the last ten items	david.peake	Outlook	0	06-01-2010 07:27 PM
Help with nested cylinders and labels	pixmanlajunta	PowerPoint	0	01-18-2010 11:25 AM