Need Looping Help
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 |
Need Looping Help
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 In article , wrote: 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. |
Need Looping Help
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 wrote: 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 In article , wrote: 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. |
All times are GMT +1. The time now is 04:14 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com