Sleeper: Making this code more dynamic [Archive]

View Full Version : Sleeper: Making this code more dynamic

crmpicco

05-26-2005, 02:28 AM

Can anyone see away of making this code more dynamic with respect to the 'TotalCell' variable:

While flag <> True
sRightRange = getColumnLetter(iCol + iFlag) & iRow
'... the amount of cells that are merged together
'... a.k.a the Column Span for the HTML table
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell2 = TotalCell
'... if it is not empty then write another <td>
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
'... the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell3 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell2 + TotalCell + iFlag) & iRow ' ...
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell4 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow ' ...
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell5 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell4 + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow ' ...
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell6 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell5 + TotalCell4 + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow ' ...
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell7 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell6 + TotalCell5 + TotalCell4 + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow ' ...
TotalCell = Range(sRightRange).MergeArea.Cells.Count
TotalCell8 = TotalCell
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell7 + TotalCell6 + TotalCell5 + TotalCell4 + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow
' ...TotalCell = Range(sRightRange).MergeArea.Cells.Count
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
sRightRange = getColumnLetter(iCol + TotalCell8 + TotalCell7 + TotalCell6 + TotalCell5 + TotalCell4 + TotalCell3 + TotalCell2 + TotalCell + iFlag) & iRow
' ...TotalCell = Range(sRightRange).MergeArea.Cells.Count
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCell & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCell + iFlag) & iRow
ElseIf Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
End If
iFlag = iFlag + 1
'... while flag <> true
Wend

crmpicco

05-26-2005, 03:38 AM

you may notice that i have to manually set TotalCell2, TotalCell3, etc.. is there a way this can be incremented automatically?

Bob Phillips

05-26-2005, 03:43 AM

you may notice that i have to manually set TotalCell2, TotalCell3, etc.. is there a way this can be incremented automatically?

Use an array of TotalCell (1 To 8) and put the common code in a sub routine of its own and call that with an array index.

crmpicco

05-26-2005, 04:01 AM

how do i do that?

crmpicco

05-26-2005, 04:24 AM

and call that with an array index.

Its that bit i'm not sure of

crmpicco

05-26-2005, 06:37 AM

you got code?

Bob Phillips

05-26-2005, 09:45 AM

Here is a shot.

Beware, it is not tested, and there may be some more optimisations that you can use but I didn't really follow the code in some parts.

The array should be declared outside of the modules, in Declaratives, so it is available to all procedures.

Private TotalCells(1 To 8)
While flag <> True
sRightRange = getColumnLetter(iCol + iFlag) & iRow
'... the amount of cells that are merged together
'... a.k.a the Column Span for the HTML table
TotalCells(1) = Range(sRightRange).MergeArea.Cells.Count
TotalCells(2) = TotalCells(1)
'... if it is not empty then write another <td>
If Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCells(1) & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRightRange).Text)) '... the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
PopulateTotalsArray 4,sRightRange,iCol,Row, Flag
SetupTotals sRightRange
PopulateTotalsArray 5,sRightRange,iCol,Row, Flag
SetupTotals sRightRange
PopulateTotalsArray 6,sRightRange,iCol,Row, Flag
SetupTotals sRightRange
PopulateTotalsArray 7,sRightRange,iCol,Row, Flag
SetupTotals sRightRange
PopulateTotalsArray 8,sRightRange,iCol,Row, Flag
SetupTotals sRightRange
sRightRange = getColumnLetter(iCol + TotalCells(7) + _TotalCells(6) + TotalCells(5) + _
TotalCells(4) + TotalCells(3) + TotalCells(2) + TotalCells(1) + iFlag) & iRow ' ...
TotalCells(1) = Range(sRightRange).MergeArea.Cells.Count
SetupTotals sRightRange
sRightRange = getColumnLetter(iCol + TotalCells(8) + TotalCells(7 + TotalCells(6) + TotalCells(5) + _
TotalCells(4) + TotalCells(3) + TotalCells(2) + TotalCells(1) + iFlag) & iRow ' ...
TotalCells(1) = Range(sRightRange).MergeArea.Cells.Count
SetupTotals sRightRange
End If
iFlag = iFlag + 1
'... while flag <> true
Wend

Private Sub SetupTotals (ByVal sRange)
If Trim(Range(sRange).Text) <> "" Then
the_Content = the_Content & "<td colspan=" & TotalCells(1) & " align=center>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(sRange).Text))
the_Content = the_Content & "</td>"
'sRightRange = getColumnLetter(iCol + TotalCells(1) + iFlag) & iRow
ElseIf Trim(Range(sRange).Text) = "" Then
the_Content = the_Content & "</tr>"
flag = True
'... if the cell is empty
End If
End Sub

Private Sub PopulateTotalsArray(ByVal idx As Long, ByVal sRange, ByVal col, ByVal row, ByVal Flag)
Dim tmp
Dim i as Long
For i = 1 to idx-2
tmp = tmp + TotalCells(i)
next i
sRange = getColumnLetter(Col + tmp + Flag) & Row ' ...
TotalCells(1) = Range(sRightRange).MergeArea.Cells.Count
TotalCells(idx) = TotalCells(1)
End Sub

crmpicco

05-27-2005, 06:42 AM

what about this code, can this be made more dynamic:

For m = tempRow To iTotalRows
sRange = Chr(tempCol) & m
tempRange = Chr(tempCol + 1) & m
If Trim$(Range(sRange).Text) <> "" Then
Range(sRange).Interior.ColorIndex = iColour
End If
sRange = Chr(tempCol + 2) & m
If Trim(Range(sRange).Text) <> "" Then
Range(sRange).Interior.ColorIndex = iColour
End If
sRange = Chr(tempCol + 4) & m
If Trim(Range(sRange).Text) <> "" Then
Range(sRange).Interior.ColorIndex = iColour
End If
Next m

Bob Phillips

05-27-2005, 06:55 AM

what about this code, can this be made more dynamic

Not so much more dynamic, but less repetitive

For m = tempRow To iTotalRows
tempRange = Chr(tempCol + 1) & m
For i = 0 To 4 Step 2
sRange = Chr(tempCol + i) & m
If Trim$(Range(sRange).Text) <> "" Then
Range(sRange).Interior.ColorIndex = iColour
End If
Next i
Next m