crmpicco
05-19-2005, 06:37 AM
I keep getting an Overflow error 6 with this code and i cant see what it is:
'... loop through all rows
For iRow = 1 To iTotalRows
flag = False
'... loop through all columns
For iCol = 1 To iTotalCols
sRange = getColumnLetter(iCol) & iRow
Range(sRange).Select
'... if the any cells are bold then remove the formatting from them
Selection.Font.Bold = False
'... the current cell colour
iCurrentCellCol = Range(sRange).Interior.ColorIndex
'... if the colour of the current cell is not WHITE
If iCurrentCellCol <> gbFLUSH_COLOUR Then
For k = LBound(gaFareBasisColour) To 0
iFahrpreisPos = InStr(gaFareBasisColour(k), "/")
iArrayFareBasisColour = Mid(gaFareBasisColour(k), iFahrpreisPos + 1, Len(gaFareBasisColour(k)) - 1)
If iCurrentCellCol = iArrayFareBasisColour Then
'... while the end of the tr has not been reached
While EndFareBasis <> True
sRange = getColumnLetter(iCol + iAddOne) & iRow
picco = True
sRechtsRange = getColumnLetter(iCol + iAddOne + 1) & iRow
'... if the cell is not blank
If Trim(Range(sRange).Text) <> "" Then
the_FareBasis = the_FareBasis & "<td>"
the_FareBasis = the_FareBasis & fix_characters(Trim(Range(sRange).Text))
the_FareBasis = the_FareBasis & "</td>"
bGefundenFareBasis = True
ElseIf Trim(Range(sRange).Text) = "" And Trim(Range(sRechtsRange).Text) = "" Then
EndFareBasis = True
End If
iAddOne = iAddOne + 1
Wend
End If
Next
For j = LBound(gaRulesColour) To UBound(gaRulesColour)
iPos = InStr(gaRulesColour(j), "/")
iArrayColour = Mid(gaRulesColour(j), iPos + 1, Len(gaRulesColour(j)) - 1)
If iCurrentCellCol = iArrayColour Then
If the_Heading <> "" And the_FareBasis <> "" Then
rulesXML = rulesXML & "<fare_rule_lines>"
rulesXML = rulesXML & "<heading>" & fix_characters(fix_ampersand(the_Heading)) & "</heading>"
rulesXML = rulesXML & "<content>" & the_FareBasis & fix_characters(Trim(the_Content)) & "</content>"
rulesXML = rulesXML & "</fare_rule_lines>"
End If
the_Heading = fix_ampersand(Trim(Range(sRange).Text))
the_Content = "<table>"
End If
iPos = InStr(gaContentColour(j), "/")
iArrayContentColour = Mid(gaContentColour(j), iPos + 1, Len(gaContentColour(j)) - 1)
iCurrentCellColour = Range(sRange).Interior.ColorIndex
If iCurrentCellColour <> 2 Then
'... if the current cell is the same as the colour of the content in the template
If iCurrentCellColour = iArrayContentColour Then
iFlag = 0
While flag <> True
sRightRange = getColumnLetter(iCol + iFlag + 1) & iRow
'... if it is not empty then write another <td>
If iFlag = 0 And Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<tr>"
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
ElseIf iFlag = 0 And Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "<tr>"
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
the_Content = the_Content & "</tr>"
flag = True
ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
the_Content = the_Content & "</tr>"
flag = True
ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
'... if the cell is empty
End If
iFlag = iFlag + 1
'... while flag <> true
Wend
the_Content = the_Content & "</table>"
'... if the cell is the same as the colour in the template
End If
End If
Next j
End If
'... loop through each column
Next iCol
If iRow = iTotalRows Then
If the_Heading <> "" And the_FareBasis <> "" Then
rulesXML = rulesXML & "<fare_rule_lines>"
rulesXML = rulesXML & "<heading>" & fix_characters(fix_ampersand(Trim(the_Heading))) & "</heading>"
rulesXML = rulesXML & "<content>" & the_FareBasis & fix_characters(Trim(the_Content)) & "</content>"
rulesXML = rulesXML & "</fare_rule_lines>"
End If
'the_Heading = fix_ampersand(Trim(Range(sRange).Text))
'the_Content = "<table>"
End If
'... loop through each row
Next iRow
'... loop through all rows
For iRow = 1 To iTotalRows
flag = False
'... loop through all columns
For iCol = 1 To iTotalCols
sRange = getColumnLetter(iCol) & iRow
Range(sRange).Select
'... if the any cells are bold then remove the formatting from them
Selection.Font.Bold = False
'... the current cell colour
iCurrentCellCol = Range(sRange).Interior.ColorIndex
'... if the colour of the current cell is not WHITE
If iCurrentCellCol <> gbFLUSH_COLOUR Then
For k = LBound(gaFareBasisColour) To 0
iFahrpreisPos = InStr(gaFareBasisColour(k), "/")
iArrayFareBasisColour = Mid(gaFareBasisColour(k), iFahrpreisPos + 1, Len(gaFareBasisColour(k)) - 1)
If iCurrentCellCol = iArrayFareBasisColour Then
'... while the end of the tr has not been reached
While EndFareBasis <> True
sRange = getColumnLetter(iCol + iAddOne) & iRow
picco = True
sRechtsRange = getColumnLetter(iCol + iAddOne + 1) & iRow
'... if the cell is not blank
If Trim(Range(sRange).Text) <> "" Then
the_FareBasis = the_FareBasis & "<td>"
the_FareBasis = the_FareBasis & fix_characters(Trim(Range(sRange).Text))
the_FareBasis = the_FareBasis & "</td>"
bGefundenFareBasis = True
ElseIf Trim(Range(sRange).Text) = "" And Trim(Range(sRechtsRange).Text) = "" Then
EndFareBasis = True
End If
iAddOne = iAddOne + 1
Wend
End If
Next
For j = LBound(gaRulesColour) To UBound(gaRulesColour)
iPos = InStr(gaRulesColour(j), "/")
iArrayColour = Mid(gaRulesColour(j), iPos + 1, Len(gaRulesColour(j)) - 1)
If iCurrentCellCol = iArrayColour Then
If the_Heading <> "" And the_FareBasis <> "" Then
rulesXML = rulesXML & "<fare_rule_lines>"
rulesXML = rulesXML & "<heading>" & fix_characters(fix_ampersand(the_Heading)) & "</heading>"
rulesXML = rulesXML & "<content>" & the_FareBasis & fix_characters(Trim(the_Content)) & "</content>"
rulesXML = rulesXML & "</fare_rule_lines>"
End If
the_Heading = fix_ampersand(Trim(Range(sRange).Text))
the_Content = "<table>"
End If
iPos = InStr(gaContentColour(j), "/")
iArrayContentColour = Mid(gaContentColour(j), iPos + 1, Len(gaContentColour(j)) - 1)
iCurrentCellColour = Range(sRange).Interior.ColorIndex
If iCurrentCellColour <> 2 Then
'... if the current cell is the same as the colour of the content in the template
If iCurrentCellColour = iArrayContentColour Then
iFlag = 0
While flag <> True
sRightRange = getColumnLetter(iCol + iFlag + 1) & iRow
'... if it is not empty then write another <td>
If iFlag = 0 And Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<tr>"
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
ElseIf iFlag = 0 And Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "<tr>"
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
the_Content = the_Content & "</tr>"
flag = True
ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) = "" Then
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
the_Content = the_Content & "</tr>"
flag = True
ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) <> "" Then
the_Content = the_Content & "<td>"
the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
the_Content = the_Content & "</td>"
'... if the cell is empty
End If
iFlag = iFlag + 1
'... while flag <> true
Wend
the_Content = the_Content & "</table>"
'... if the cell is the same as the colour in the template
End If
End If
Next j
End If
'... loop through each column
Next iCol
If iRow = iTotalRows Then
If the_Heading <> "" And the_FareBasis <> "" Then
rulesXML = rulesXML & "<fare_rule_lines>"
rulesXML = rulesXML & "<heading>" & fix_characters(fix_ampersand(Trim(the_Heading))) & "</heading>"
rulesXML = rulesXML & "<content>" & the_FareBasis & fix_characters(Trim(the_Content)) & "</content>"
rulesXML = rulesXML & "</fare_rule_lines>"
End If
'the_Heading = fix_ampersand(Trim(Range(sRange).Text))
'the_Content = "<table>"
End If
'... loop through each row
Next iRow