For iRow = 1 To iTotalRows    ' for {2}

            flag = False

            For iCol = 1 To (iTotalCols)    ' for {3}

                bFoundCellCol = False

                sRange = getColumnLetter(iCol) & iRow
                Range(sRange).Select

                iCurrentCellCol = Range(sRange).Interior.ColorIndex

                'MsgBox "range(srange) = " & Range(sRange)

                For j = LBound(gaRulesColour) To UBound(gaRulesColour)    ' for {4}
                    iPos = InStr(gaRulesColour(j), "/")
                    iArrayColour = Mid(gaRulesColour(j), iPos + 1, Len(gaRulesColour(j)) - 1)


                    'If the_Heading <> "" Then
                    'MsgBox the_Heading
                    'End If

                    If iCurrentCellCol = iArrayColour Then    ' if {1}


                        If the_Heading <> "" Then

                            rulesXML = rulesXML & "<fare_rule_lines>"
                            rulesXML = rulesXML & "<heading>" & fix_characters(Trim(the_Heading)) & "</heading>"
                            rulesXML = rulesXML & "<content>" & fix_characters(Trim(the_Content)) & "</content>"
                            rulesXML = rulesXML & "</fare_rule_lines>"

                        End If

                        the_Heading = fix_ampersand(Trim(Range(sRange).Text))
                        the_Content = "&lt;table&gt;"

                    End If

                    iPos = InStr(gaContentColour(j), "/")
                    iArrayContentColour = Mid(gaContentColour(j), iPos + 1, Len(gaContentColour(j)) - 1)

                    'sRange = getColumnLetter(iCol + 1) & iRow
                    iCurrentCellColour = Range(sRange).Interior.ColorIndex
                    If iCurrentCellColour <> 2 Then    ' if {1}

                        'sRange = getColumnLetter(iCol + 1) & iRow
                        'sRightRange = sRange

                        ' if the current cell is the same as the colour of the content in the template
                        If iCurrentCellColour = iArrayContentColour Then
                            iFlag = 0

                            'the_Content = the_Content & "&lt;tr&gt;"
                            'the_Content = the_Content & "&lt;td&gt;"
                            'the_Content = the_Content & Trim(Range(sRange).Text)
                            'the_Content = the_Content & "&lt;/td&gt;"
                            While flag <> True

                                If iRow = 88 Then
                                    iRow = 88
                                End If
                                sRightRange = getColumnLetter(iCol + iFlag + 1) & iRow

                                'sRange = getColumnLetter(iCol + iFlag) & iRow

                                ' if it is not empty then write another <td>
                                If iFlag = 0 And Trim(Range(sRightRange).Text) <> "" Then
                                    the_Content = the_Content & "&lt;tr&gt;"
                                    the_Content = the_Content & "&lt;td&gt;"
                                    the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
                                    the_Content = the_Content & "&lt;/td&gt;"
                                ElseIf iFlag = 0 And Trim(Range(sRightRange).Text) = "" Then
                                    the_Content = the_Content & "&lt;tr&gt;"
                                    the_Content = the_Content & "&lt;td&gt;"
                                    the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
                                    the_Content = the_Content & "&lt;/td&gt;"
                                    the_Content = the_Content & "&lt;/tr&gt;"
                                    flag = True
                                ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) = "" Then
                                    the_Content = the_Content & "&lt;td&gt;"
                                    the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
                                    the_Content = the_Content & "&lt;/td&gt;"
                                    the_Content = the_Content & "&lt;/tr&gt;"
                                    flag = True
                                ElseIf iFlag <> 0 And Trim(Range(sRightRange).Text) <> "" Then
                                    the_Content = the_Content & "&lt;td&gt;"
                                    the_Content = the_Content & fix_ampersand_to_amp(Trim(Range(getColumnLetter(iCol + iFlag) & iRow).Text))
                                    the_Content = the_Content & "&lt;/td&gt;"

                                End If    ' if the cell is empty

                                'MsgBox the_Content
                                iFlag = iFlag + 1

                            Wend    ' while flag <> true

                        End If    ' if the cell is the same as the colour in the template

                    End If

                Next j

                ' loop through each column
            Next iCol

            ' loop through each row
        Next iRow

     www.crmpicco.co.uk
     www.crmpicco.co.uk.tt
     www.milklemonadechocolate.uk.tt
     www.griswolds.uk.tt
     www.piccosmini.co.uk.tt
     www.morton.uk.tt