View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
J.E. McGimpsey J.E. McGimpsey is offline
external usenet poster
 
Posts: 493
Default 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.