Need Looping Help

L

lance-news

I have created a bottleneck for myself because I am unsure how to loop
the following code. The code works as is but instead of running this on
numbers from 3 - 15 I would prefer to run it on 2 - infinity
(theoretically).

Goto:
' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN PROFILE
' BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO FIND THE START COLUMN FOR
CONCANTENATION

to see the code I am referring to


Basically I need a loop to create selectcol[??] and then I need
a loop to concantenate columns.






Any help would be appreciated.

Lance








Sub test()
Application.ScreenUpdating = False
'Define for testing
Numsegments = 6

Range("F:F").Select
Selection.NumberFormat = "#,##0.00"
With Selection
.HorizontalAlignment = xlCenter
End With
Cells(1, 1).Select

For rowIndex = 4 To 1000
If Not IsEmpty(Cells(rowIndex, 1)) Then
colIndex = 9


'PUT COMPARISONS HEADERS (IJ) AND P VALUES IN ROWS
'P VALUES
For Comparisons = 1 To (Numsegments * (Numsegments - 1))
Cells(rowIndex + (Comparisons - 1), 6).Select
Application.CutCopyMode = False
Selection.Copy
Cells(rowIndex, (colIndex + Comparisons + 1)).Select
ActiveSheet.Paste

'HEADERS
Cells(rowIndex - 1, (colIndex + Comparisons + 1)).Select
If Not IsEmpty(Cells(rowIndex + (Comparisons - 1), 2))
Then Val1 = Cells(rowIndex + (Comparisons - 1), 2)
Val2 = Cells(rowIndex + (Comparisons - 1), 3)
Val3 = Val1 & Val2
ActiveCell.Value = Val3


'PUT COMPARISONS HEADERS (IJ) AND J VALUES IN ROWS IF P VALUES < .05
'P VALUES
Cells(rowIndex + (Comparisons - 1), 6).Select
Application.CutCopyMode = False
Selection.Copy
Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Select
ActiveSheet.Paste

'HEADERS
Cells(rowIndex - 1, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Select
If Not IsEmpty(Cells(rowIndex + (Comparisons - 1), 2))
Then Val1 = Cells(rowIndex + (Comparisons - 1), 2)
Val2 = Cells(rowIndex + (Comparisons - 1), 3)
Val3 = Val1 & Val2
ActiveCell.Value = Val3



Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Select

If (Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Value > 0.1) Then
Selection.Value = " "
End If

If (Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Value <= 0.05) Then
Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Value = Val2
Selection.NumberFormat = "#0"
With Selection.Font
.FontStyle = "Bold"
End With
End If

If (Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Value <= 0.1) Then
Cells(rowIndex, (colIndex + (Comparisons +
((Numsegments * (Numsegments - 1))) + 2))).Value = Val2
Selection.NumberFormat = "#0"
End If








' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN PROFILE
' BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO FIND THE START COLUMN FOR
CONCANTENATION

Selectcol1 = (colIndex + (Numsegments * (Numsegments -
1)) + 3)
Selectcol2 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1)))
Selectcol3 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 2))
Selectcol4 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 3))
Selectcol5 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 4))
Selectcol6 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 5))
Selectcol7 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 6))
Selectcol8 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 7))
Selectcol9 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 8))
Selectcol10 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 9))
Selectcol11 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 10))
Selectcol12 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 11))
Selectcol13 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 12))
Selectcol14 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 13))
Selectcol15 = (colIndex + (Numsegments * (Numsegments -
1)) + 3 + ((Numsegments - 1) * 14))







'CONCANTENATE COMPARISONS SO THAT THERE ARE ONLY NUMSEGMENTS COLUMNS AND
ROWS HAVE DIFFERENCES

'HEADERS
For J = 1 To Numsegments
Cells(rowIndex - 1, (colIndex + (((Numsegments *
(Numsegments - 1)) * 2) + 3 + J))).Select
ActiveCell.Value = J


'CONCANTENATED COLUMNS

Cells(rowIndex, (colIndex + (((Numsegments *
(Numsegments - 1)) * 2) + 3 + J))).Select

If (Numsegments = 3 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1)
If (Numsegments = 3 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1)
If (Numsegments = 3 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1)

If (Numsegments = 4 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2)
If (Numsegments = 4 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2)
If (Numsegments = 4 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2)
If (Numsegments = 4 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2)

If (Numsegments = 5 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3)
If (Numsegments = 5 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3)
If (Numsegments = 5 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3)
If (Numsegments = 5 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3)
If (Numsegments = 5 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3)

If (Numsegments = 6 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3) &
Cells(rowIndex, Selectcol1 + 4)
If (Numsegments = 6 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3) &
Cells(rowIndex, Selectcol2 + 4)
If (Numsegments = 6 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3) &
Cells(rowIndex, Selectcol3 + 4)
If (Numsegments = 6 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3) &
Cells(rowIndex, Selectcol4 + 4)
If (Numsegments = 6 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3) &
Cells(rowIndex, Selectcol5 + 4)
If (Numsegments = 6 And J = 6) Then ActiveCell =
Cells(rowIndex, Selectcol6) & Cells(rowIndex, Selectcol6 + 1) &
Cells(rowIndex, Selectcol6 + 2) & Cells(rowIndex, Selectcol6 + 3) &
Cells(rowIndex, Selectcol6 + 4)

If (Numsegments = 7 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3) &
Cells(rowIndex, Selectcol1 + 4) & Cells(rowIndex, Selectcol1 + 5)
If (Numsegments = 7 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3) &
Cells(rowIndex, Selectcol2 + 4) & Cells(rowIndex, Selectcol2 + 5)
If (Numsegments = 7 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3) &
Cells(rowIndex, Selectcol3 + 4) & Cells(rowIndex, Selectcol3 + 5)
If (Numsegments = 7 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3) &
Cells(rowIndex, Selectcol4 + 4) & Cells(rowIndex, Selectcol4 + 5)
If (Numsegments = 7 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3) &
Cells(rowIndex, Selectcol5 + 4) & Cells(rowIndex, Selectcol5 + 5)
If (Numsegments = 7 And J = 6) Then ActiveCell =
Cells(rowIndex, Selectcol6) & Cells(rowIndex, Selectcol6 + 1) &
Cells(rowIndex, Selectcol6 + 2) & Cells(rowIndex, Selectcol6 + 3) &
Cells(rowIndex, Selectcol6 + 4) & Cells(rowIndex, Selectcol6 + 5)
If (Numsegments = 7 And J = 7) Then ActiveCell =
Cells(rowIndex, Selectcol7) & Cells(rowIndex, Selectcol7 + 1) &
Cells(rowIndex, Selectcol7 + 2) & Cells(rowIndex, Selectcol7 + 3) &
Cells(rowIndex, Selectcol7 + 4) & Cells(rowIndex, Selectcol7 + 5)

If (Numsegments = 8 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3) &
Cells(rowIndex, Selectcol1 + 4) & Cells(rowIndex, Selectcol1 + 5) &
Cells(rowIndex, Selectcol1 + 6)
If (Numsegments = 8 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3) &
Cells(rowIndex, Selectcol2 + 4) & Cells(rowIndex, Selectcol2 + 5) &
Cells(rowIndex, Selectcol2 + 6)
If (Numsegments = 8 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3) &
Cells(rowIndex, Selectcol3 + 4) & Cells(rowIndex, Selectcol3 + 5) &
Cells(rowIndex, Selectcol3 + 6)
If (Numsegments = 8 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3) &
Cells(rowIndex, Selectcol4 + 4) & Cells(rowIndex, Selectcol4 + 5) &
Cells(rowIndex, Selectcol4 + 6)
If (Numsegments = 8 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3) &
Cells(rowIndex, Selectcol5 + 4) & Cells(rowIndex, Selectcol5 + 5) &
Cells(rowIndex, Selectcol5 + 6)
If (Numsegments = 8 And J = 6) Then ActiveCell =
Cells(rowIndex, Selectcol6) & Cells(rowIndex, Selectcol6 + 1) &
Cells(rowIndex, Selectcol6 + 2) & Cells(rowIndex, Selectcol6 + 3) &
Cells(rowIndex, Selectcol6 + 4) & Cells(rowIndex, Selectcol6 + 5) &
Cells(rowIndex, Selectcol6 + 6)
If (Numsegments = 8 And J = 7) Then ActiveCell =
Cells(rowIndex, Selectcol7) & Cells(rowIndex, Selectcol7 + 1) &
Cells(rowIndex, Selectcol7 + 2) & Cells(rowIndex, Selectcol7 + 3) &
Cells(rowIndex, Selectcol7 + 4) & Cells(rowIndex, Selectcol7 + 5) &
Cells(rowIndex, Selectcol7 + 6)
If (Numsegments = 8 And J = 8) Then ActiveCell =
Cells(rowIndex, Selectcol8) & Cells(rowIndex, Selectcol8 + 1) &
Cells(rowIndex, Selectcol8 + 2) & Cells(rowIndex, Selectcol8 + 3) &
Cells(rowIndex, Selectcol8 + 4) & Cells(rowIndex, Selectcol8 + 5) &
Cells(rowIndex, Selectcol8 + 6)

If (Numsegments = 9 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3) &
Cells(rowIndex, Selectcol1 + 4) & Cells(rowIndex, Selectcol1 + 5) &
Cells(rowIndex, Selectcol1 + 6) & Cells(rowIndex, Selectcol1 + 7)
If (Numsegments = 9 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3) &
Cells(rowIndex, Selectcol2 + 4) & Cells(rowIndex, Selectcol2 + 5) &
Cells(rowIndex, Selectcol2 + 6) & Cells(rowIndex, Selectcol2 + 7)
If (Numsegments = 9 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3) &
Cells(rowIndex, Selectcol3 + 4) & Cells(rowIndex, Selectcol3 + 5) &
Cells(rowIndex, Selectcol3 + 6) & Cells(rowIndex, Selectcol3 + 7)
If (Numsegments = 9 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3) &
Cells(rowIndex, Selectcol4 + 4) & Cells(rowIndex, Selectcol4 + 5) &
Cells(rowIndex, Selectcol4 + 6) & Cells(rowIndex, Selectcol4 + 7)
If (Numsegments = 9 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3) &
Cells(rowIndex, Selectcol5 + 4) & Cells(rowIndex, Selectcol5 + 5) &
Cells(rowIndex, Selectcol5 + 6) & Cells(rowIndex, Selectcol5 + 7)
If (Numsegments = 9 And J = 6) Then ActiveCell =
Cells(rowIndex, Selectcol6) & Cells(rowIndex, Selectcol6 + 1) &
Cells(rowIndex, Selectcol6 + 2) & Cells(rowIndex, Selectcol6 + 3) &
Cells(rowIndex, Selectcol6 + 4) & Cells(rowIndex, Selectcol6 + 5) &
Cells(rowIndex, Selectcol6 + 6) & Cells(rowIndex, Selectcol6 + 7)
If (Numsegments = 9 And J = 7) Then ActiveCell =
Cells(rowIndex, Selectcol7) & Cells(rowIndex, Selectcol7 + 1) &
Cells(rowIndex, Selectcol7 + 2) & Cells(rowIndex, Selectcol7 + 3) &
Cells(rowIndex, Selectcol7 + 4) & Cells(rowIndex, Selectcol7 + 5) &
Cells(rowIndex, Selectcol7 + 6) & Cells(rowIndex, Selectcol7 + 7)
If (Numsegments = 9 And J = 8) Then ActiveCell =
Cells(rowIndex, Selectcol8) & Cells(rowIndex, Selectcol8 + 1) &
Cells(rowIndex, Selectcol8 + 2) & Cells(rowIndex, Selectcol8 + 3) &
Cells(rowIndex, Selectcol8 + 4) & Cells(rowIndex, Selectcol8 + 5) &
Cells(rowIndex, Selectcol8 + 6) & Cells(rowIndex, Selectcol8 + 7)
If (Numsegments = 9 And J = 9) Then ActiveCell =
Cells(rowIndex, Selectcol9) & Cells(rowIndex, Selectcol9 + 1) &
Cells(rowIndex, Selectcol9 + 2) & Cells(rowIndex, Selectcol9 + 3) &
Cells(rowIndex, Selectcol9 + 4) & Cells(rowIndex, Selectcol9 + 5) &
Cells(rowIndex, Selectcol9 + 6) & Cells(rowIndex, Selectcol9 + 7)

If (Numsegments = 10 And J = 1) Then ActiveCell =
Cells(rowIndex, Selectcol1) & Cells(rowIndex, Selectcol1 + 1) &
Cells(rowIndex, Selectcol1 + 2) & Cells(rowIndex, Selectcol1 + 3) &
Cells(rowIndex, Selectcol1 + 4) & Cells(rowIndex, Selectcol1 + 5) &
Cells(rowIndex, Selectcol1 + 6) & Cells(rowIndex, Selectcol1 + 7) &
Cells(rowIndex, Selectcol1 + 8)
If (Numsegments = 10 And J = 2) Then ActiveCell =
Cells(rowIndex, Selectcol2) & Cells(rowIndex, Selectcol2 + 1) &
Cells(rowIndex, Selectcol2 + 2) & Cells(rowIndex, Selectcol2 + 3) &
Cells(rowIndex, Selectcol2 + 4) & Cells(rowIndex, Selectcol2 + 5) &
Cells(rowIndex, Selectcol2 + 6) & Cells(rowIndex, Selectcol2 + 7) &
Cells(rowIndex, Selectcol2 + 8)
If (Numsegments = 10 And J = 3) Then ActiveCell =
Cells(rowIndex, Selectcol3) & Cells(rowIndex, Selectcol3 + 1) &
Cells(rowIndex, Selectcol3 + 2) & Cells(rowIndex, Selectcol3 + 3) &
Cells(rowIndex, Selectcol3 + 4) & Cells(rowIndex, Selectcol3 + 5) &
Cells(rowIndex, Selectcol3 + 6) & Cells(rowIndex, Selectcol3 + 7) &
Cells(rowIndex, Selectcol3 + 8)
If (Numsegments = 10 And J = 4) Then ActiveCell =
Cells(rowIndex, Selectcol4) & Cells(rowIndex, Selectcol4 + 1) &
Cells(rowIndex, Selectcol4 + 2) & Cells(rowIndex, Selectcol4 + 3) &
Cells(rowIndex, Selectcol4 + 4) & Cells(rowIndex, Selectcol4 + 5) &
Cells(rowIndex, Selectcol4 + 6) & Cells(rowIndex, Selectcol4 + 7) &
Cells(rowIndex, Selectcol4 + 8)
If (Numsegments = 10 And J = 5) Then ActiveCell =
Cells(rowIndex, Selectcol5) & Cells(rowIndex, Selectcol5 + 1) &
Cells(rowIndex, Selectcol5 + 2) & Cells(rowIndex, Selectcol5 + 3) &
Cells(rowIndex, Selectcol5 + 4) & Cells(rowIndex, Selectcol5 + 5) &
Cells(rowIndex, Selectcol5 + 6) & Cells(rowIndex, Selectcol5 + 7) &
Cells(rowIndex, Selectcol5 + 8)
If (Numsegments = 10 And J = 6) Then ActiveCell =
Cells(rowIndex, Selectcol6) & Cells(rowIndex, Selectcol6 + 1) &
Cells(rowIndex, Selectcol6 + 2) & Cells(rowIndex, Selectcol6 + 3) &
Cells(rowIndex, Selectcol6 + 4) & Cells(rowIndex, Selectcol6 + 5) &
Cells(rowIndex, Selectcol6 + 6) & Cells(rowIndex, Selectcol6 + 7) &
Cells(rowIndex, Selectcol6 + 8)
If (Numsegments = 10 And J = 7) Then ActiveCell =
Cells(rowIndex, Selectcol7) & Cells(rowIndex, Selectcol7 + 1) &
Cells(rowIndex, Selectcol7 + 2) & Cells(rowIndex, Selectcol7 + 3) &
Cells(rowIndex, Selectcol7 + 4) & Cells(rowIndex, Selectcol7 + 5) &
Cells(rowIndex, Selectcol7 + 6) & Cells(rowIndex, Selectcol7 + 7) &
Cells(rowIndex, Selectcol7 + 8)
If (Numsegments = 10 And J = 8) Then ActiveCell =
Cells(rowIndex, Selectcol8) & Cells(rowIndex, Selectcol8 + 1) &
Cells(rowIndex, Selectcol8 + 2) & Cells(rowIndex, Selectcol8 + 3) &
Cells(rowIndex, Selectcol8 + 4) & Cells(rowIndex, Selectcol8 + 5) &
Cells(rowIndex, Selectcol8 + 6) & Cells(rowIndex, Selectcol8 + 7) &
Cells(rowIndex, Selectcol8 + 8)
If (Numsegments = 10 And J = 9) Then ActiveCell =
Cells(rowIndex, Selectcol9) & Cells(rowIndex, Selectcol9 + 1) &
Cells(rowIndex, Selectcol9 + 2) & Cells(rowIndex, Selectcol9 + 3) &
Cells(rowIndex, Selectcol9 + 4) & Cells(rowIndex, Selectcol9 + 5) &
Cells(rowIndex, Selectcol9 + 6) & Cells(rowIndex, Selectcol9 + 7) &
Cells(rowIndex, Selectcol9 + 8)
If (Numsegments = 10 And J = 10) Then ActiveCell =
Cells(rowIndex, Selectcol10) & Cells(rowIndex, Selectcol10 + 1) &
Cells(rowIndex, Selectcol10 + 2) & Cells(rowIndex, Selectcol10 + 3) &
Cells(rowIndex, Selectcol10 + 4) & Cells(rowIndex, Selectcol10 + 5) &
Cells(rowIndex, Selectcol10 + 6) & Cells(rowIndex, Selectcol10 + 7) &
Cells(rowIndex, Selectcol10 + 8)

Next J





Next Comparisons







End If
Next rowIndex

Cells(4, 1).Value = "IJ Comparison"


Range("A4:A1000").Select
For I = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(I)) = 0 Then
Selection.Rows(I).EntireRow.Hidden = True
End If
Next I

End Sub
 
J

J.E. McGimpsey

You haven't analyzed your bottleneck quite right.

Take your line:

Selectcol15 = (colIndex + (Numsegments * _
(Numsegments - 1)) + 3 + ((Numsegments - 1) * 14))

That will only be needed if Numsegments >=15, but

Selectcol15 = (9 + 15 * 14 + 3 + 14 * 14) = 418

which is more than the maximum number of columns in a worksheet. In
fact, Numsegments can't exceed 11 unless you go to a different
spreadsheet application.

I went through and shortened your code a bit - I believe I kept the
same logic, though since it's not obvious what you're doing, I can't
be sure. It should show you one way to do the loops you want, and it
should be quite a bit faster (I kept your comments in approximately
the same place as in your code):

Public Sub test()
'Define for testing
Const NUMSEGMENTS As Integer = 6
Const COLINDEX As Integer = 9
Dim val2 As Variant
Dim hideRange As Range
Dim rowIndex As Long
Dim comparisons As Integer
Dim i As Integer
Dim j As Integer
Dim StartCol() As Integer
Dim NSq As Integer
Dim sTemp As String

Application.ScreenUpdating = False
NSq = (NUMSEGMENTS * (NUMSEGMENTS - 1))
With Range("F:F")
.NumberFormat = "#,##0.00"
.HorizontalAlignment = xlCenter
End With
For rowIndex = 4 To 1000
If Not IsEmpty(Cells(rowIndex, 1).Value) Then
' PUT COMPARISONS HEADERS (IJ) AND P VALUES IN ROWS
' P VALUES
For comparisons = 1 To NSq
val2 = Cells(rowIndex + comparisons - 1, 3).Value
Cells(rowIndex + comparisons - 1, 6).Copy _
Cells(rowIndex, COLINDEX + comparisons + 1)
' HEADERS
Cells(rowIndex - 1, COLINDEX + comparisons + 1).Value = _
Cells(rowIndex + comparisons - 1, 2).Value & val2
' PUT COMPARISONS HEADERS (IJ) AND J VALUES IN ROWS IF
' P VALUES < .05
' P VALUES
Cells(rowIndex + (comparisons - 1), 6).Copy _
Cells(rowIndex, COLINDEX + comparisons + NSq + 2)
' HEADERS
Cells(rowIndex - 1, _
COLINDEX + comparisons + NSq + 2).Value = _
Cells(rowIndex + comparisons - 1, 2).Value & val2
With Cells(rowIndex, COLINDEX + comparisons + NSq + 2)
If .Value <= 0.1 Then
.Value = val2
.NumberFormat = "#0"
If .Value <= 0.05 Then .Font.FontStyle = "Bold"
Else
.ClearContents
End If
End With
' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN
' PROFILE BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO
' FIND THE START COLUMN FOR CONCATENATION
ReDim StartCol(1 To NUMSEGMENTS)
StartCol(1) = COLINDEX + NSq
For i = 2 To UBound(StartCol)
StartCol(i) = StartCol(1) + 3 + _
(NUMSEGMENTS - 1) ^ (i - 1)
Next i
' CONCATENATE COMPARISONS SO THAT THERE ARE ONLY
' NUMSEGMENTS COLUMNS AND ROWS HAVE DIFFERENCES
' HEADERS
For j = 1 To NUMSEGMENTS
Cells(rowIndex - 1, _
COLINDEX + NSq * 2 + 3 + j).Value = j
'CONCATENATED COLUMNS
sTemp = ""
For i = 0 To NUMSEGMENTS - 2
sTemp = sTemp & _
Cells(rowIndex, StartCol(j) + i).Value
Next i
Cells(rowIndex, _
COLINDEX + NSq * 2 + 3 + j).Value = sTemp
Next j
Next comparisons
End If
Next rowIndex
Cells(4, 1).Value = "IJ Comparison"
For i = 5 To 1000
If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
If hideRange Is Nothing Then
Set hideRange = Rows(i)
Else
Set hideRange = Union(hideRange, Rows(i))
End If
End If
Next i
If Not hideRange Is Nothing Then _
hideRange.EntireRow.Hidden = True
End Sub



I have created a bottleneck for myself because I am unsure how to loop
the following code. The code works as is but instead of running this on
numbers from 3 - 15 I would prefer to run it on 2 - infinity
(theoretically).

Goto:
' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN PROFILE
' BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO FIND THE START COLUMN FOR
CONCANTENATION

to see the code I am referring to


Basically I need a loop to create selectcol[??] and then I need
a loop to concantenate columns.






Any help would be appreciated.
Click to expand...
 
L

lance-news

Yeah, I found out today that I could only use Numsegments<=11 unless I
remove some columns of info first. I am only working from 2-11 now.
I appreciate your help with the Loops. I am working on something else
today but hope to play around with it soon.

Lance


J.E. McGimpsey said:
You haven't analyzed your bottleneck quite right.

Take your line:

Selectcol15 = (colIndex + (Numsegments * _
(Numsegments - 1)) + 3 + ((Numsegments - 1) * 14))

That will only be needed if Numsegments >=15, but

Selectcol15 = (9 + 15 * 14 + 3 + 14 * 14) = 418

which is more than the maximum number of columns in a worksheet. In
fact, Numsegments can't exceed 11 unless you go to a different
spreadsheet application.

I went through and shortened your code a bit - I believe I kept the
same logic, though since it's not obvious what you're doing, I can't
be sure. It should show you one way to do the loops you want, and it
should be quite a bit faster (I kept your comments in approximately
the same place as in your code):

Public Sub test()
'Define for testing
Const NUMSEGMENTS As Integer = 6
Const COLINDEX As Integer = 9
Dim val2 As Variant
Dim hideRange As Range
Dim rowIndex As Long
Dim comparisons As Integer
Dim i As Integer
Dim j As Integer
Dim StartCol() As Integer
Dim NSq As Integer
Dim sTemp As String

Application.ScreenUpdating = False
NSq = (NUMSEGMENTS * (NUMSEGMENTS - 1))
With Range("F:F")
.NumberFormat = "#,##0.00"
.HorizontalAlignment = xlCenter
End With
For rowIndex = 4 To 1000
If Not IsEmpty(Cells(rowIndex, 1).Value) Then
' PUT COMPARISONS HEADERS (IJ) AND P VALUES IN ROWS
' P VALUES
For comparisons = 1 To NSq
val2 = Cells(rowIndex + comparisons - 1, 3).Value
Cells(rowIndex + comparisons - 1, 6).Copy _
Cells(rowIndex, COLINDEX + comparisons + 1)
' HEADERS
Cells(rowIndex - 1, COLINDEX + comparisons + 1).Value = _
Cells(rowIndex + comparisons - 1, 2).Value & val2
' PUT COMPARISONS HEADERS (IJ) AND J VALUES IN ROWS IF
' P VALUES < .05
' P VALUES
Cells(rowIndex + (comparisons - 1), 6).Copy _
Cells(rowIndex, COLINDEX + comparisons + NSq + 2)
' HEADERS
Cells(rowIndex - 1, _
COLINDEX + comparisons + NSq + 2).Value = _
Cells(rowIndex + comparisons - 1, 2).Value & val2
With Cells(rowIndex, COLINDEX + comparisons + NSq + 2)
If .Value <= 0.1 Then
.Value = val2
.NumberFormat = "#0"
If .Value <= 0.05 Then .Font.FontStyle = "Bold"
Else
.ClearContents
End If
End With
' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN
' PROFILE BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO
' FIND THE START COLUMN FOR CONCATENATION
ReDim StartCol(1 To NUMSEGMENTS)
StartCol(1) = COLINDEX + NSq
For i = 2 To UBound(StartCol)
StartCol(i) = StartCol(1) + 3 + _
(NUMSEGMENTS - 1) ^ (i - 1)
Next i
' CONCATENATE COMPARISONS SO THAT THERE ARE ONLY
' NUMSEGMENTS COLUMNS AND ROWS HAVE DIFFERENCES
' HEADERS
For j = 1 To NUMSEGMENTS
Cells(rowIndex - 1, _
COLINDEX + NSq * 2 + 3 + j).Value = j
'CONCATENATED COLUMNS
sTemp = ""
For i = 0 To NUMSEGMENTS - 2
sTemp = sTemp & _
Cells(rowIndex, StartCol(j) + i).Value
Next i
Cells(rowIndex, _
COLINDEX + NSq * 2 + 3 + j).Value = sTemp
Next j
Next comparisons
End If
Next rowIndex
Cells(4, 1).Value = "IJ Comparison"
For i = 5 To 1000
If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
If hideRange Is Nothing Then
Set hideRange = Rows(i)
Else
Set hideRange = Union(hideRange, Rows(i))
End If
End If
Next i
If Not hideRange Is Nothing Then _
hideRange.EntireRow.Hidden = True
End Sub



I have created a bottleneck for myself because I am unsure how to loop
the following code. The code works as is but instead of running this on
numbers from 3 - 15 I would prefer to run it on 2 - infinity
(theoretically).

Goto:
' THIS SECTION IS LIMITING THE NUMBER OF SEGMENTS I CAN PROFILE
' BECAUSE I CANNOT FIGURE OUT A BETTER WAY TO FIND THE START COLUMN FOR
CONCANTENATION

to see the code I am referring to


Basically I need a loop to create selectcol[??] and then I need
a loop to concantenate columns.






Any help would be appreciated.
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Retrieving Excel data to post to a form 2
vba coding question 0
Error in excel com: Microsoft.Office.Interop.Excel Exception from HRESULT: 0x800A03EC 3
How can I count Rows and Columns 3
Use range to move data between worksheets 0
Dynamically populating a 14-column listbox 3
VBA Calculation Error 10
Insert Textbox values to seperate rows/columns 3

Top