Ali•MESHKOT•com

Sample Work

Sample Visual Basic for Applications (VBA) Code for MS Excel

The following original code demonstrates some programming techniques and object naming, which are meaningful and in accordance with a predefined naming convention.


Option Explicit

Dim RowValue, Found, LastCellInColAddress, CellObject
Const strSalesListToday = "SalesList"
Const strSalesListPrev = "SalesListOld"
Const strFilePath = "\\Data2002A\Internet\SalesSearch\"



'   SetDefaults Module

'   This module will set the default or user variable values
'   The values are taken from the worksheet named VariableValues.
'   When user values are left blank (empty string),
'   then the default values are used.
'   Dr. M. A. Meshkot   Feb 2002
'   Ref 13801113
Public gbolUseDefaultValues As Boolean
Public gstrNewList As String
Public gstrPrevList As String
Public gstrSelectedList As String
Public gbolDeleteOldList As Boolean
Public gstrFilter1 As String
Public gstrFilter2 As String
Public gstrFilter3 As String
Public gstrFilter4 As String
Public gstrFilePath As String
Public gstrNewListFilename As String
Public gstrPrevListFilename As String
Public gstrListSheetName As String
Public gstrAttachmentPath As String
Public gintListColWidth As Integer
Public gintDataCleanColumnRelative As Integer
Public gintDataCompareColumnRelative As Integer
Public gintEmailBatchSize As Integer
Public gIntShowScreenInterval As Integer
Public gstrFilenameFormat As String
Public gintMarkColumnNumberSelectRelative As Integer
Public gintMarkColumnNumberNewRelative As Integer
Public gintTempColumnNumberRelative As Integer
Public gintPasteColumnNumber As Integer
Public gintAttachmentAdsColNumberRel As Integer
Public gMarkColourNew As Integer
Public gMarkColourSelect As Integer
Public gMarkColourCopied As Integer
Public gMarkColourAfterEmail1 As Integer
Public gMarkColourBeforeEmail2 As Integer
Public gMarkColourAfterEmail2 As Integer
Public gintEmail1Email2Delay As Integer
Public Const colWhite = &H80000014
Public Const colGrey = 15
Public Const colDarkGrey = 48
Public Const colYellow = 6
Public Const colPink = 7
Public Const colFilterOn = &H80FF80
Public Const colFilterOff = &H8000000F
Public Const cSelect = "Select Worksheet"
Public Const bolNew = True
Public Const bolPrev = False
Public Const cDataColCount = 14
Public Const cFollowUpColRelative = 18 ' Follow-up column relative to col. A=0
Public Const cEmail1Lines = 50
Public Const cEmail2Lines = 35
Public Const cMaxAttachments = 10
Public Const cZero = "Zero"
Public Const cNoDataSource = "No Data Source Worksheet has been selected"
Public Const quote = """"
Public gstrColHeading(1 To cDataColCount) As String
Public gstrEmail1HTMLBodyLine(1 To cEmail1Lines) As String
Public gstrEmail2HTMLBodyLine(1 To cEmail2Lines) As String

Public Type Attachment
    ID(1 To cMaxAttachments) As String
    FilePath(1 To cMaxAttachments) As String
End Type

Public gstrAttachment As Attachment
Public gstrSourceDataWorksheetName As String
Public gvarMessage


Sub SetDefaultValues()

Dim VariableBlockAddress
Dim NextValueAddress
    With Sheets("VariableValues")
        '   Select the block of variable names and values starting at cell C4
        VariableBlockAddress = .Range("B4").End(xlDown).Offset(0, 1).Address
        .Activate
        .Range("B4:" & VariableBlockAddress).Select
        ' Create Names for variable values, giving them the variable name
        ' Note that the variable block has to be SELECTED before the names
        '   can be created.
        Selection.CreateNames Top:=False, Left:=True, Bottom:=False, Right:=False
        .Range("B4").Select
    End With
    gbolUseDefaultValues = Range(Names("gbolUseDefaultValues")).Value
    gstrSelectedList = Range(Names("gstrSelectedList")).Value
    gbolDeleteOldList = Range(Names("gbolDeleteOldList")).Value
    gstrFilter1 = Range(Names("gstrFilter1")).Value
    gstrFilter2 = Range(Names("gstrFilter2")).Value
    gstrFilter3 = Range(Names("gstrFilter3")).Value
    gstrFilter4 = Range(Names("gstrFilter4")).Value
    gstrFilePath = Range(Names("gstrFilePath")).Value
    gstrNewListFilename = Range(Names("gstrNewListFilename")).Value
    gstrPrevListFilename = Range(Names("gstrPrevListFilename")).Value
    gintListColWidth = Range(Names("gintListColWidth")).Value
    gintDataCleanColumnRelative = CInt(Range(Names("gintDataCleanColumnRelative")).Value)
    gintDataCompareColumnRelative = CInt(Range(Names("gintDataCompareColumnRelative")).Value)
    gintEmailBatchSize = CInt(Range(Names("gintEmailBatchSize")).Value)
    gIntShowScreenInterval = Range(Names("gIntShowScreenInterval")).Value
    gstrFilenameFormat = Range(Names("gstrFilenameFormat")).Value
    gintMarkColumnNumberSelectRelative = CInt(Range(Names("gintMarkColumnNumberSelectRelative")).Value)
    gintMarkColumnNumberNewRelative = CInt(Range(Names("gintMarkColumnNumberNewRelative")).Value)
    gintTempColumnNumberRelative = CInt(Range(Names("gintTempColumnNumberRelative")).Value)
    gintPasteColumnNumber = CInt(Range(Names("gintPasteColumnNumber")).Value)
    gintAttachmentAdsColNumberRel = CInt(Range(Names("gintAttachmentAdsColNumberRel")).Value)
    gMarkColourNew = Range(Names("gMarkColourNew")).Interior.ColorIndex
    gMarkColourSelect = Range(Names("gMarkColourSelect")).Interior.ColorIndex
    gMarkColourCopied = Range(Names("gMarkColourCopied")).Interior.ColorIndex
    gMarkColourAfterEmail1 = Range(Names("gMarkColourAfterEmail1")).Interior.ColorIndex
    gMarkColourBeforeEmail2 = Range(Names("gMarkColourBeforeEmail2")).Interior.ColorIndex
    gMarkColourAfterEmail2 = Range(Names("gMarkColourAfterEmail2")).Interior.ColorIndex
    gintEmail1Email2Delay = CInt(Range(Names("gintEmail1Email2Delay")).Value)
    
    gstrColHeading(1) = Range(Names("gstrColHeading_1")).Value
    gstrColHeading(2) = Range(Names("gstrColHeading_2")).Value
    gstrColHeading(3) = Range(Names("gstrColHeading_3")).Value
    gstrColHeading(4) = Range(Names("gstrColHeading_4")).Value
    gstrColHeading(5) = Range(Names("gstrColHeading_5")).Value
    gstrColHeading(6) = Range(Names("gstrColHeading_6")).Value
    gstrColHeading(7) = Range(Names("gstrColHeading_7")).Value
    gstrColHeading(8) = Range(Names("gstrColHeading_8")).Value
    gstrColHeading(9) = Range(Names("gstrColHeading_9")).Value
    gstrColHeading(10) = Range(Names("gstrColHeading_10")).Value
    gstrColHeading(11) = Range(Names("gstrColHeading_11")).Value
    gstrColHeading(12) = Range(Names("gstrColHeading_12")).Value
    gstrColHeading(13) = Range(Names("gstrColHeading_13")).Value
    gstrColHeading(14) = Range(Names("gstrColHeading_14")).Value
    
    gstrEmail1HTMLBodyLine(1) = Range(Names("gstrEmail1HTMLBodyLine_1")).Value
    gstrEmail1HTMLBodyLine(2) = Range(Names("gstrEmail1HTMLBodyLine_2")).Value
    gstrEmail1HTMLBodyLine(3) = Range(Names("gstrEmail1HTMLBodyLine_3")).Value
    gstrEmail1HTMLBodyLine(4) = Range(Names("gstrEmail1HTMLBodyLine_4")).Value
    gstrEmail1HTMLBodyLine(5) = Range(Names("gstrEmail1HTMLBodyLine_5")).Value
    gstrEmail1HTMLBodyLine(6) = Range(Names("gstrEmail1HTMLBodyLine_6")).Value
    gstrEmail1HTMLBodyLine(7) = Range(Names("gstrEmail1HTMLBodyLine_7")).Value
    gstrEmail1HTMLBodyLine(8) = Range(Names("gstrEmail1HTMLBodyLine_8")).Value
    gstrEmail1HTMLBodyLine(9) = Range(Names("gstrEmail1HTMLBodyLine_9")).Value
    gstrEmail1HTMLBodyLine(10) = Range(Names("gstrEmail1HTMLBodyLine_10")).Value
    gstrEmail1HTMLBodyLine(11) = Range(Names("gstrEmail1HTMLBodyLine_11")).Value
    gstrEmail1HTMLBodyLine(12) = Range(Names("gstrEmail1HTMLBodyLine_12")).Value
    gstrEmail1HTMLBodyLine(13) = Range(Names("gstrEmail1HTMLBodyLine_13")).Value
    gstrEmail1HTMLBodyLine(14) = Range(Names("gstrEmail1HTMLBodyLine_14")).Value
    gstrEmail1HTMLBodyLine(15) = Range(Names("gstrEmail1HTMLBodyLine_15")).Value
    gstrEmail1HTMLBodyLine(16) = Range(Names("gstrEmail1HTMLBodyLine_16")).Value
    gstrEmail1HTMLBodyLine(17) = Range(Names("gstrEmail1HTMLBodyLine_17")).Value
    gstrEmail1HTMLBodyLine(18) = Range(Names("gstrEmail1HTMLBodyLine_18")).Value
    gstrEmail1HTMLBodyLine(19) = Range(Names("gstrEmail1HTMLBodyLine_19")).Value
    gstrEmail1HTMLBodyLine(20) = Range(Names("gstrEmail1HTMLBodyLine_20")).Value
    gstrEmail1HTMLBodyLine(21) = Range(Names("gstrEmail1HTMLBodyLine_21")).Value
    gstrEmail1HTMLBodyLine(22) = Range(Names("gstrEmail1HTMLBodyLine_22")).Value
    gstrEmail1HTMLBodyLine(23) = Range(Names("gstrEmail1HTMLBodyLine_23")).Value
    gstrEmail1HTMLBodyLine(24) = Range(Names("gstrEmail1HTMLBodyLine_24")).Value
    gstrEmail1HTMLBodyLine(25) = Range(Names("gstrEmail1HTMLBodyLine_25")).Value
    gstrEmail1HTMLBodyLine(26) = Range(Names("gstrEmail1HTMLBodyLine_26")).Value
    gstrEmail1HTMLBodyLine(27) = Range(Names("gstrEmail1HTMLBodyLine_27")).Value
    gstrEmail1HTMLBodyLine(28) = Range(Names("gstrEmail1HTMLBodyLine_28")).Value
    gstrEmail1HTMLBodyLine(29) = Range(Names("gstrEmail1HTMLBodyLine_29")).Value
    gstrEmail1HTMLBodyLine(30) = Range(Names("gstrEmail1HTMLBodyLine_30")).Value
    gstrEmail1HTMLBodyLine(31) = Range(Names("gstrEmail1HTMLBodyLine_31")).Value
    gstrEmail1HTMLBodyLine(32) = Range(Names("gstrEmail1HTMLBodyLine_32")).Value
    gstrEmail1HTMLBodyLine(33) = Range(Names("gstrEmail1HTMLBodyLine_33")).Value
    gstrEmail1HTMLBodyLine(34) = Range(Names("gstrEmail1HTMLBodyLine_34")).Value
    gstrEmail1HTMLBodyLine(35) = Range(Names("gstrEmail1HTMLBodyLine_35")).Value
    gstrEmail1HTMLBodyLine(36) = Range(Names("gstrEmail1HTMLBodyLine_36")).Value
    gstrEmail1HTMLBodyLine(37) = Range(Names("gstrEmail1HTMLBodyLine_37")).Value
    gstrEmail1HTMLBodyLine(38) = Range(Names("gstrEmail1HTMLBodyLine_38")).Value
    gstrEmail1HTMLBodyLine(39) = Range(Names("gstrEmail1HTMLBodyLine_39")).Value
    gstrEmail1HTMLBodyLine(40) = Range(Names("gstrEmail1HTMLBodyLine_40")).Value
    gstrEmail1HTMLBodyLine(41) = Range(Names("gstrEmail1HTMLBodyLine_41")).Value
    gstrEmail1HTMLBodyLine(42) = Range(Names("gstrEmail1HTMLBodyLine_42")).Value
    gstrEmail1HTMLBodyLine(43) = Range(Names("gstrEmail1HTMLBodyLine_43")).Value
    gstrEmail1HTMLBodyLine(44) = Range(Names("gstrEmail1HTMLBodyLine_44")).Value
    gstrEmail1HTMLBodyLine(45) = Range(Names("gstrEmail1HTMLBodyLine_45")).Value
    gstrEmail1HTMLBodyLine(46) = Range(Names("gstrEmail1HTMLBodyLine_46")).Value
    gstrEmail1HTMLBodyLine(47) = Range(Names("gstrEmail1HTMLBodyLine_47")).Value
    gstrEmail1HTMLBodyLine(48) = Range(Names("gstrEmail1HTMLBodyLine_48")).Value
    gstrEmail1HTMLBodyLine(49) = Range(Names("gstrEmail1HTMLBodyLine_49")).Value
    gstrEmail1HTMLBodyLine(50) = Range(Names("gstrEmail1HTMLBodyLine_50")).Value

    gstrAttachment.ID(1) = Range(Names("gstrAttachment_ID_1")).Value
    gstrAttachment.ID(2) = Range(Names("gstrAttachment_ID_2")).Value
    gstrAttachment.ID(3) = Range(Names("gstrAttachment_ID_3")).Value
    gstrAttachment.ID(4) = Range(Names("gstrAttachment_ID_4")).Value
    gstrAttachment.ID(5) = Range(Names("gstrAttachment_ID_5")).Value
    gstrAttachment.ID(6) = Range(Names("gstrAttachment_ID_6")).Value
    gstrAttachment.ID(7) = Range(Names("gstrAttachment_ID_7")).Value
    gstrAttachment.ID(8) = Range(Names("gstrAttachment_ID_8")).Value
    gstrAttachment.ID(9) = Range(Names("gstrAttachment_ID_9")).Value
    gstrAttachment.ID(10) = Range(Names("gstrAttachment_ID_10")).Value

    gstrAttachment.FilePath(1) = Range(Names("gstrAttachment_FilePath_1")).Value
    gstrAttachment.FilePath(2) = Range(Names("gstrAttachment_FilePath_2")).Value
    gstrAttachment.FilePath(3) = Range(Names("gstrAttachment_FilePath_3")).Value
    gstrAttachment.FilePath(4) = Range(Names("gstrAttachment_FilePath_4")).Value
    gstrAttachment.FilePath(5) = Range(Names("gstrAttachment_FilePath_5")).Value
    gstrAttachment.FilePath(6) = Range(Names("gstrAttachment_FilePath_6")).Value
    gstrAttachment.FilePath(7) = Range(Names("gstrAttachment_FilePath_7")).Value
    gstrAttachment.FilePath(8) = Range(Names("gstrAttachment_FilePath_8")).Value
    gstrAttachment.FilePath(9) = Range(Names("gstrAttachment_FilePath_9")).Value
    gstrAttachment.FilePath(10) = Range(Names("gstrAttachment_FilePath_10")).Value

    gstrEmail2HTMLBodyLine(1) = Range(Names("gstrEmail2HTMLBodyLine_1")).Value
    gstrEmail2HTMLBodyLine(2) = Range(Names("gstrEmail2HTMLBodyLine_2")).Value
    gstrEmail2HTMLBodyLine(3) = Range(Names("gstrEmail2HTMLBodyLine_3")).Value
    gstrEmail2HTMLBodyLine(4) = Range(Names("gstrEmail2HTMLBodyLine_4")).Value
    gstrEmail2HTMLBodyLine(5) = Range(Names("gstrEmail2HTMLBodyLine_5")).Value
    gstrEmail2HTMLBodyLine(6) = Range(Names("gstrEmail2HTMLBodyLine_6")).Value
    gstrEmail2HTMLBodyLine(7) = Range(Names("gstrEmail2HTMLBodyLine_7")).Value
    gstrEmail2HTMLBodyLine(8) = Range(Names("gstrEmail2HTMLBodyLine_8")).Value
    gstrEmail2HTMLBodyLine(9) = Range(Names("gstrEmail2HTMLBodyLine_9")).Value
    gstrEmail2HTMLBodyLine(10) = Range(Names("gstrEmail2HTMLBodyLine_10")).Value
    gstrEmail2HTMLBodyLine(11) = Range(Names("gstrEmail2HTMLBodyLine_11")).Value
    gstrEmail2HTMLBodyLine(12) = Range(Names("gstrEmail2HTMLBodyLine_12")).Value
    gstrEmail2HTMLBodyLine(13) = Range(Names("gstrEmail2HTMLBodyLine_13")).Value
    gstrEmail2HTMLBodyLine(14) = Range(Names("gstrEmail2HTMLBodyLine_14")).Value
    gstrEmail2HTMLBodyLine(15) = Range(Names("gstrEmail2HTMLBodyLine_15")).Value
    gstrEmail2HTMLBodyLine(16) = Range(Names("gstrEmail2HTMLBodyLine_16")).Value
    gstrEmail2HTMLBodyLine(17) = Range(Names("gstrEmail2HTMLBodyLine_17")).Value
    gstrEmail2HTMLBodyLine(18) = Range(Names("gstrEmail2HTMLBodyLine_18")).Value
    gstrEmail2HTMLBodyLine(19) = Range(Names("gstrEmail2HTMLBodyLine_19")).Value
    gstrEmail2HTMLBodyLine(20) = Range(Names("gstrEmail2HTMLBodyLine_20")).Value
    gstrEmail2HTMLBodyLine(21) = Range(Names("gstrEmail2HTMLBodyLine_21")).Value
    gstrEmail2HTMLBodyLine(22) = Range(Names("gstrEmail2HTMLBodyLine_22")).Value
    gstrEmail2HTMLBodyLine(23) = Range(Names("gstrEmail2HTMLBodyLine_23")).Value
    gstrEmail2HTMLBodyLine(24) = Range(Names("gstrEmail2HTMLBodyLine_24")).Value
    gstrEmail2HTMLBodyLine(25) = Range(Names("gstrEmail2HTMLBodyLine_25")).Value
    gstrEmail2HTMLBodyLine(26) = Range(Names("gstrEmail2HTMLBodyLine_26")).Value
    gstrEmail2HTMLBodyLine(27) = Range(Names("gstrEmail2HTMLBodyLine_27")).Value
    gstrEmail2HTMLBodyLine(28) = Range(Names("gstrEmail2HTMLBodyLine_28")).Value
    gstrEmail2HTMLBodyLine(29) = Range(Names("gstrEmail2HTMLBodyLine_29")).Value
    gstrEmail2HTMLBodyLine(30) = Range(Names("gstrEmail2HTMLBodyLine_30")).Value
    gstrEmail2HTMLBodyLine(31) = Range(Names("gstrEmail2HTMLBodyLine_31")).Value
    gstrEmail2HTMLBodyLine(32) = Range(Names("gstrEmail2HTMLBodyLine_32")).Value
    gstrEmail2HTMLBodyLine(33) = Range(Names("gstrEmail2HTMLBodyLine_33")).Value
'   Special Casses of variable values
'    gstrNewListFilename = "Sales" & Format(Format(Date - 1, "yymmdd"), "000000") & ".csv"
'    gstrPrevListFilename = "Sales" & Format(Format(Date - 2, "yymmdd"), "000000") & ".csv"
    Range("B4").Select
End Sub


Sub SetUserValues()

    SetDefaultValues
'   Set User Values from cells adjacent to the default values.
    
    If CStr(Range(Names("gstrSelectedList")).Offset(0, 1).Value) <> "" Then _
        gstrSelectedList = Range(Names("gstrSelectedList")).Offset(0, 1).Value
    If CStr(Range(Names("gbolDeleteOldList")).Offset(0, 1).Value) <> "" Then _
        gbolDeleteOldList = CBool(Range(Names("gbolDeleteOldList")).Offset(0, 1).Value)
    If CStr(Range(Names("gstrFilter1")).Offset(0, 1).Value) <> "" Then _
        gstrFilter1 = Range(Names("gstrFilter1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrFilter2")).Offset(0, 1).Value) <> "" Then _
        gstrFilter2 = Range(Names("gstrFilter2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrFilter3")).Offset(0, 1).Value) <> "" Then _
        gstrFilter3 = Range(Names("gstrFilter3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrFilter4")).Offset(0, 1).Value) <> "" Then _
        gstrFilter4 = Range(Names("gstrFilter4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrFilePath")).Offset(0, 1).Value) <> "" Then _
        gstrFilePath = Range(Names("gstrFilePath")).Offset(0, 1).Value
    
    If CStr(Range(Names("gstrNewListFilename")).Offset(0, 1).Value) <> "" Then _
        gstrNewListFilename = Range(Names("gstrNewListFilename")).Offset(0, 1).Value
    If CStr(Range(Names("gstrPrevListFilename")).Offset(0, 1).Value) <> "" Then _
        gstrPrevListFilename = Range(Names("gstrPrevListFilename")).Offset(0, 1).Value
    If CStr(Range(Names("gintListColWidth")).Offset(0, 1).Value) <> "" Then _
        gintListColWidth = CInt(Range(Names("gintListColWidth")).Offset(0, 1).Value)
    If CStr(Range(Names("gintDataCleanColumnRelative")).Offset(0, 1).Value) <> "" Then _
        gintDataCleanColumnRelative = Range(Names("gintDataCleanColumnRelative")).Offset(0, 1).Value
    If CStr(Range(Names("gintDataCompareColumnRelative")).Offset(0, 1).Value) <> "" Then _
        gintDataCompareColumnRelative = Range(Names("gintDataCompareColumnRelative")).Offset(0, 1).Value
    If CStr(Range(Names("gintEmailBatchSize")).Offset(0, 1).Value) <> "" Then _
        gintEmailBatchSize = Range(Names("gintEmailBatchSize")).Offset(0, 1).Value
    If CStr(Range(Names("gIntShowScreenInterval")).Offset(0, 1).Value) <> "" Then _
        gIntShowScreenInterval = Range(Names("gIntShowScreenInterval")).Offset(0, 1).Value
    If CStr(Range(Names("gstrFilenameFormat")).Offset(0, 1).Value) <> "" Then _
        gstrFilenameFormat = Range(Names("gstrFilenameFormat")).Offset(0, 1).Value
    If CStr(Range(Names("gintMarkColumnNumberSelectRelative")).Offset(0, 1).Value) <> "" Then _
        gintMarkColumnNumberSelectRelative = CInt(Range(Names("gintMarkColumnNumberSelectRelative")).Offset(0, 1).Value)
    If CStr(Range(Names("gintMarkColumnNumberNewRelative")).Offset(0, 1).Value) <> "" Then _
        gintMarkColumnNumberNewRelative = CInt(Range(Names("gintMarkColumnNumberNewRelative")).Offset(0, 1).Value)
    If CStr(Range(Names("gintTempColumnNumberRelative")).Offset(0, 1).Value) <> "" Then _
        gintTempColumnNumberRelative = CInt(Range(Names("gintTempColumnNumberRelative")).Offset(0, 1).Value)
    If CStr(Range(Names("gintPasteColumnNumber")).Offset(0, 1).Value) <> "" Then _
        gintPasteColumnNumber = CInt(Range(Names("gintPasteColumnNumber")).Offset(0, 1).Value)
    If CStr(Range(Names("gintAttachmentAdsColNumberRel")).Offset(0, 1).Value) <> "" Then _
        gintAttachmentAdsColNumberRel = CInt(Range(Names("gintAttachmentAdsColNumberRel")).Offset(0, 1).Value)
    ' For the colour indeces, check the the user's selected colour <>
    ' colour of the cell containing the variable name (Windows background colour).
    If Range(Names("gMarkColourNew")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourNew")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourNew = Range(Names("gMarkColourNew")).Offset(0, 1).Interior.ColorIndex
    If Range(Names("gMarkColourSelect")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourSelect")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourSelect = Range(Names("gMarkColourSelect")).Offset(0, 1).Interior.ColorIndex
    If Range(Names("gMarkColourCopied")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourCopied")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourCopied = Range(Names("gMarkColourCopied")).Offset(0, 1).Interior.ColorIndex
    If Range(Names("gMarkColourAfterEmail1")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourAfterEmail1")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourAfterEmail1 = Range(Names("gMarkColourAfterEmail1")).Offset(0, 1).Interior.ColorIndex
    If Range(Names("gMarkColourBeforeEmail2")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourBeforeEmail2")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourBeforeEmail2 = Range(Names("gMarkColourBeforeEmail2")).Offset(0, 1).Interior.ColorIndex
    If Range(Names("gMarkColourAfterEmail2")).Offset(0, 1).Interior.ColorIndex <> _
        Range(Names("gMarkColourAfterEmail2")).Offset(0, -1).Interior.ColorIndex Then _
        gMarkColourAfterEmail2 = Range(Names("gMarkColourAfterEmail2")).Offset(0, 1).Interior.ColorIndex
    If CStr(Range(Names("gintEmail1Email2Delay")).Offset(0, 1).Value) <> "" Then _
        gintEmail1Email2Delay = Range(Names("gintEmail1Email2Delay")).Offset(0, 1).Value
        
    If CStr(Range(Names("gstrColHeading_1")).Offset(0, 1).Value) <> "" Then gstrColHeading(1) = Range(Names("gstrColHeading_1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_2")).Offset(0, 1).Value) <> "" Then gstrColHeading(2) = Range(Names("gstrColHeading_2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_3")).Offset(0, 1).Value) <> "" Then gstrColHeading(3) = Range(Names("gstrColHeading_3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_4")).Offset(0, 1).Value) <> "" Then gstrColHeading(4) = Range(Names("gstrColHeading_4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_5")).Offset(0, 1).Value) <> "" Then gstrColHeading(5) = Range(Names("gstrColHeading_5")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_6")).Offset(0, 1).Value) <> "" Then gstrColHeading(6) = Range(Names("gstrColHeading_6")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_7")).Offset(0, 1).Value) <> "" Then gstrColHeading(7) = Range(Names("gstrColHeading_7")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_8")).Offset(0, 1).Value) <> "" Then gstrColHeading(8) = Range(Names("gstrColHeading_8")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_9")).Offset(0, 1).Value) <> "" Then gstrColHeading(9) = Range(Names("gstrColHeading_9")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_10")).Offset(0, 1).Value) <> "" Then gstrColHeading(10) = Range(Names("gstrColHeading_10")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_11")).Offset(0, 1).Value) <> "" Then gstrColHeading(11) = Range(Names("gstrColHeading_11")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_12")).Offset(0, 1).Value) <> "" Then gstrColHeading(12) = Range(Names("gstrColHeading_12")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_13")).Offset(0, 1).Value) <> "" Then gstrColHeading(13) = Range(Names("gstrColHeading_13")).Offset(0, 1).Value
    If CStr(Range(Names("gstrColHeading_14")).Offset(0, 1).Value) <> "" Then gstrColHeading(14) = Range(Names("gstrColHeading_14")).Offset(0, 1).Value
    
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_1")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(1) = Range(Names("gstrEmail1HTMLBodyLine_1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_2")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(2) = Range(Names("gstrEmail1HTMLBodyLine_2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_3")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(3) = Range(Names("gstrEmail1HTMLBodyLine_3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_4")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(4) = Range(Names("gstrEmail1HTMLBodyLine_4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_5")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(5) = Range(Names("gstrEmail1HTMLBodyLine_5")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_6")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(6) = Range(Names("gstrEmail1HTMLBodyLine_6")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_7")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(7) = Range(Names("gstrEmail1HTMLBodyLine_7")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_8")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(8) = Range(Names("gstrEmail1HTMLBodyLine_8")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_9")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(9) = Range(Names("gstrEmail1HTMLBodyLine_9")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_10")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(10) = Range(Names("gstrEmail1HTMLBodyLine_10")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_11")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(11) = Range(Names("gstrEmail1HTMLBodyLine_11")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_12")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(12) = Range(Names("gstrEmail1HTMLBodyLine_12")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_13")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(13) = Range(Names("gstrEmail1HTMLBodyLine_13")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_14")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(14) = Range(Names("gstrEmail1HTMLBodyLine_14")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_15")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(15) = Range(Names("gstrEmail1HTMLBodyLine_15")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_16")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(16) = Range(Names("gstrEmail1HTMLBodyLine_16")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_17")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(17) = Range(Names("gstrEmail1HTMLBodyLine_17")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_18")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(18) = Range(Names("gstrEmail1HTMLBodyLine_18")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_19")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(19) = Range(Names("gstrEmail1HTMLBodyLine_19")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_20")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(20) = Range(Names("gstrEmail1HTMLBodyLine_20")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_21")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(21) = Range(Names("gstrEmail1HTMLBodyLine_21")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_22")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(22) = Range(Names("gstrEmail1HTMLBodyLine_22")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_23")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(23) = Range(Names("gstrEmail1HTMLBodyLine_23")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_24")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(24) = Range(Names("gstrEmail1HTMLBodyLine_24")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_25")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(25) = Range(Names("gstrEmail1HTMLBodyLine_25")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_26")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(26) = Range(Names("gstrEmail1HTMLBodyLine_26")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_27")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(27) = Range(Names("gstrEmail1HTMLBodyLine_27")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_28")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(28) = Range(Names("gstrEmail1HTMLBodyLine_28")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_29")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(29) = Range(Names("gstrEmail1HTMLBodyLine_29")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_30")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(30) = Range(Names("gstrEmail1HTMLBodyLine_30")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_31")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(31) = Range(Names("gstrEmail1HTMLBodyLine_31")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_32")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(32) = Range(Names("gstrEmail1HTMLBodyLine_32")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_33")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(33) = Range(Names("gstrEmail1HTMLBodyLine_33")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_34")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(34) = Range(Names("gstrEmail1HTMLBodyLine_34")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_35")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(35) = Range(Names("gstrEmail1HTMLBodyLine_35")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_36")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(36) = Range(Names("gstrEmail1HTMLBodyLine_36")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_37")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(37) = Range(Names("gstrEmail1HTMLBodyLine_37")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_38")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(38) = Range(Names("gstrEmail1HTMLBodyLine_38")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_39")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(39) = Range(Names("gstrEmail1HTMLBodyLine_39")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_40")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(40) = Range(Names("gstrEmail1HTMLBodyLine_40")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_41")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(41) = Range(Names("gstrEmail1HTMLBodyLine_41")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_42")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(42) = Range(Names("gstrEmail1HTMLBodyLine_42")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_43")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(43) = Range(Names("gstrEmail1HTMLBodyLine_43")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_44")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(44) = Range(Names("gstrEmail1HTMLBodyLine_44")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_45")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(45) = Range(Names("gstrEmail1HTMLBodyLine_45")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_46")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(46) = Range(Names("gstrEmail1HTMLBodyLine_46")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_47")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(47) = Range(Names("gstrEmail1HTMLBodyLine_47")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_48")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(48) = Range(Names("gstrEmail1HTMLBodyLine_48")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_49")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(49) = Range(Names("gstrEmail1HTMLBodyLine_49")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail1HTMLBodyLine_50")).Offset(0, 1).Value) <> "" Then gstrEmail1HTMLBodyLine(50) = Range(Names("gstrEmail1HTMLBodyLine_50")).Offset(0, 1).Value
    
    If CStr(Range(Names("gstrAttachment_ID_1")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(1) = Range(Names("gstrAttachment_ID_1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_2")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(2) = Range(Names("gstrAttachment_ID_2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_3")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(3) = Range(Names("gstrAttachment_ID_3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_4")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(4) = Range(Names("gstrAttachment_ID_4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_5")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(5) = Range(Names("gstrAttachment_ID_5")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_6")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(6) = Range(Names("gstrAttachment_ID_6")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_7")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(7) = Range(Names("gstrAttachment_ID_7")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_8")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(8) = Range(Names("gstrAttachment_ID_8")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_9")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(9) = Range(Names("gstrAttachment_ID_9")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_ID_10")).Offset(0, 1).Value) <> "" Then gstrAttachment.ID(10) = Range(Names("gstrAttachment_ID_10")).Offset(0, 1).Value
    
    If CStr(Range(Names("gstrAttachment_FilePath_1")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(1) = Range(Names("gstrAttachment_FilePath_1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_2")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(2) = Range(Names("gstrAttachment_FilePath_2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_3")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(3) = Range(Names("gstrAttachment_FilePath_3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_4")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(4) = Range(Names("gstrAttachment_FilePath_4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_5")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(5) = Range(Names("gstrAttachment_FilePath_5")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_6")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(6) = Range(Names("gstrAttachment_FilePath_6")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_7")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(7) = Range(Names("gstrAttachment_FilePath_7")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_8")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(8) = Range(Names("gstrAttachment_FilePath_8")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_9")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(9) = Range(Names("gstrAttachment_FilePath_9")).Offset(0, 1).Value
    If CStr(Range(Names("gstrAttachment_FilePath_10")).Offset(0, 1).Value) <> "" Then gstrAttachment.FilePath(10) = Range(Names("gstrAttachment_FilePath_10")).Offset(0, 1).Value
    
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_1")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(1) = Range(Names("gstrEmail2HTMLBodyLine_1")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_2")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(2) = Range(Names("gstrEmail2HTMLBodyLine_2")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_3")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(3) = Range(Names("gstrEmail2HTMLBodyLine_3")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_4")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(4) = Range(Names("gstrEmail2HTMLBodyLine_4")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_5")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(5) = Range(Names("gstrEmail2HTMLBodyLine_5")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_6")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(6) = Range(Names("gstrEmail2HTMLBodyLine_6")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_7")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(7) = Range(Names("gstrEmail2HTMLBodyLine_7")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_8")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(8) = Range(Names("gstrEmail2HTMLBodyLine_8")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_9")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(9) = Range(Names("gstrEmail2HTMLBodyLine_9")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_10")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(10) = Range(Names("gstrEmail2HTMLBodyLine_10")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_11")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(11) = Range(Names("gstrEmail2HTMLBodyLine_11")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_12")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(12) = Range(Names("gstrEmail2HTMLBodyLine_12")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_13")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(13) = Range(Names("gstrEmail2HTMLBodyLine_13")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_14")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(14) = Range(Names("gstrEmail2HTMLBodyLine_14")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_15")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(15) = Range(Names("gstrEmail2HTMLBodyLine_15")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_16")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(16) = Range(Names("gstrEmail2HTMLBodyLine_16")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_17")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(17) = Range(Names("gstrEmail2HTMLBodyLine_17")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_18")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(18) = Range(Names("gstrEmail2HTMLBodyLine_18")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_19")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(19) = Range(Names("gstrEmail2HTMLBodyLine_19")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_20")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(20) = Range(Names("gstrEmail2HTMLBodyLine_20")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_21")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(21) = Range(Names("gstrEmail2HTMLBodyLine_21")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_22")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(22) = Range(Names("gstrEmail2HTMLBodyLine_22")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_23")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(23) = Range(Names("gstrEmail2HTMLBodyLine_23")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_24")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(24) = Range(Names("gstrEmail2HTMLBodyLine_24")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_25")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(25) = Range(Names("gstrEmail2HTMLBodyLine_25")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_26")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(26) = Range(Names("gstrEmail2HTMLBodyLine_26")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_27")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(27) = Range(Names("gstrEmail2HTMLBodyLine_27")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_28")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(28) = Range(Names("gstrEmail2HTMLBodyLine_28")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_29")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(29) = Range(Names("gstrEmail2HTMLBodyLine_29")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_30")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(30) = Range(Names("gstrEmail2HTMLBodyLine_30")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_31")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(31) = Range(Names("gstrEmail2HTMLBodyLine_31")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_32")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(32) = Range(Names("gstrEmail2HTMLBodyLine_32")).Offset(0, 1).Value
    If CStr(Range(Names("gstrEmail2HTMLBodyLine_33")).Offset(0, 1).Value) <> "" Then gstrEmail2HTMLBodyLine(33) = Range(Names("gstrEmail2HTMLBodyLine_33")).Offset(0, 1).Value

End Sub


Sub SetVariableValues()

'   There must be a worksheet named VariableValues
    If Not SheetExists("VariableValues") Then
        gvarMessage = MsgBox("There must be a worksheet named 'VariableValues' with " _
            & "values for over 100 variables.", vbOKOnly, "VariableValues Worksheet not found")
        Exit Sub
    End If
'   Set the Default variable values or the User values according to the user selection.
    If Worksheets("VariableValues").Cells(4, 3) = True Then
        SetDefaultValues
    Else
        SetUserValues
    End If
End Sub


Public Sub ResetComboList()

Dim wks As Worksheet
Dim strUpperName As String
'   To reset the combo box list values showing the NewList and PrevList
'   worksheet names
    With Worksheets("DataViewForm1").cboNewList
        .ColumnCount = 1
        .ListRows = 8
        .BoundColumn = 1
        .ColumnWidths = "4 cm"
        .ListWidth = "4 cm"
        .Clear
        For Each wks In Worksheets
            strUpperName = Left(WorksheetFunction.Proper(wks.Name), 3)
            If strUpperName = Left(WorksheetFunction.Proper(gstrFilenameFormat), 3) _
                Or (wks.Name = gstrSelectedList) Then
                .AddItem wks.Name
            End If
        Next
        If SheetExists(gstrNewList) Then
            .Text = gstrNewList
            .Value = gstrNewList
        Else
            .Value = cSelect
        End If
    End With
    With Worksheets("DataViewForm1").cboPrevList
        .ColumnCount = 1
        .ListRows = 8
        .BoundColumn = 1
        .ColumnWidths = "4 cm"
        .ListWidth = "4 cm"
        .Clear
        For Each wks In Worksheets
            strUpperName = Left(WorksheetFunction.Proper(wks.Name), 3)
            If strUpperName = Left(WorksheetFunction.Proper(gstrFilenameFormat), 3) _
                Or (wks.Name = gstrSelectedList) Then
                .AddItem wks.Name
            End If
        Next
        If SheetExists(gstrPrevList) Then
            .Text = gstrPrevList
            .Value = gstrPrevList
        Else
            .Value = cSelect
        End If
    End With
End Sub



Public Sub ResetSourceDataCombo()

Dim wks As Worksheet
Dim strUpperName As String
Dim strPresentValue As String
'   To reset the combo box list values showing the NewList and PrevList
'   worksheet names
    With Worksheets("DataViewForm1").cboSourceDataWorksheet
        strPresentValue = .Value
        .Clear
        For Each wks In Worksheets
            strUpperName = Left(WorksheetFunction.Proper(wks.Name), 3)
            If strUpperName = Left(WorksheetFunction.Proper(gstrFilenameFormat), 3) _
                Or (wks.Name = gstrSelectedList) Then
                .AddItem wks.Name
            End If
        Next
        If SheetExists(strPresentValue) Then
            .Value = strPresentValue
        Else
            .Value = cSelect
        End If
    End With
End Sub



Public Function AddSheetToCombo(bolIsNew As Boolean) As Boolean

Dim wks As Worksheet
Dim strUpperName As String
    AddSheetToCombo = False
    With Worksheets("DataViewForm1").cboNewList
        .Clear
        For Each wks In Worksheets
            strUpperName = Left(WorksheetFunction.Proper(wks.Name), 3)
            If strUpperName = Left(WorksheetFunction.Proper(gstrFilenameFormat), 3) _
                Or (wks.Name = gstrSelectedList) Then
                .AddItem wks.Name
            End If
        Next
    End With
    With Worksheets("DataViewForm1").cboPrevList
        .Clear
        For Each wks In Worksheets
            strUpperName = Left(WorksheetFunction.Proper(wks.Name), 3)
            If strUpperName = Left(WorksheetFunction.Proper(gstrFilenameFormat), 3) _
                Or (wks.Name = gstrSelectedList) Then
                .AddItem wks.Name
            End If
        Next
    End With
    If bolIsNew Then    ' there has been a NewList import
        If SheetExists(gstrListSheetName) Then
            Worksheets("DataViewForm1").cboNewList.Value = gstrListSheetName
            If SheetExists(gstrPrevList) Then
                Worksheets("DataViewForm1").cboPrevList.Value = gstrPrevList
            Else
                Worksheets("DataViewForm1").cboPrevList.Value = cSelect
            End If
        Else
            Worksheets("DataViewForm1").cboNewList.Value = cSelect
            If SheetExists(gstrPrevList) Then
                Worksheets("DataViewForm1").cboPrevList.Value = gstrPrevList
            Else
                Worksheets("DataViewForm1").cboPrevList.Value = cSelect
            End If
        End If
    Else            ' There has been a PrevList import
        If SheetExists(gstrListSheetName) Then
            Worksheets("DataViewForm1").cboPrevList.Value = gstrListSheetName
            If SheetExists(gstrNewList) Then
                Worksheets("DataViewForm1").cboNewList.Value = gstrNewList
            Else
                Worksheets("DataViewForm1").cboNewList.Value = cSelect
            End If
        Else
            Worksheets("DataViewForm1").cboPrevList.Value = cSelect
            If SheetExists(gstrNewList) Then
                Worksheets("DataViewForm1").cboNewList.Value = gstrNewList
            Else
                Worksheets("DataViewForm1").cboNewList.Value = cSelect
            End If
        End If
    End If
ExitNormal:
    AddSheetToCombo = True
    Exit Function
ExitError:
    AddSheetToCombo = False
End Function





Sub ImportNewCSV()

'   Import a .csv file
    If Not ImportFile(bolNew) Then GoTo ExitError
'   Format the file to set the column headers and col. width.
    If Not FormatRawImport(bolNew) Then GoTo ExitError
'   Clean the imported data list
    If Not CleanData(gstrNewList) Then GoTo ExitError
ExitNormal:
    Exit Sub
ExitError:
    gvarMessage = MsgBox("File Import, Format or Data Cleansing failed. " _
    & "as described in a previous message for some errors.", vbOKOnly, "Import Error")
End Sub


Sub ImportPrevCSV()

'   Import a .csv file
    If Not ImportFile(bolPrev) Then GoTo ExitError
'   Format the file to set the column headers and col. width.
    If Not FormatRawImport(bolPrev) Then GoTo ExitError
'   Clean the imported data list
    If Not CleanData(gstrPrevList) Then GoTo ExitError
ExitNormal:
    Exit Sub
ExitError:
    gvarMessage = MsgBox("File Import, Format or Data Cleansing failed. " _
    & "as described in a previous message for some errors.", vbOKOnly, "Import Error")
End Sub



Function ImportFile(bolIsNew As Boolean) As Boolean

'
' Import Data File
' Import File of CSV Data, the file is old data unless bolIsNew is True
' Macro recorded 4 Feb 2002 by Dr. Meshkot
'
Dim strFilenamePath As String
Dim strFilename
Dim intCounterA
Dim intCounter

On Error GoTo ExitError1
    ImportFile = False
    SetVariableValues
'  Get filename if it was left blank in Defaults.
    If bolIsNew Then
        If gstrNewListFilename = "" Or _
            gstrNewListFilename = "ASK USER ON IMPORT" Then
            With Application.FileDialog(msoFileDialogFilePicker)
                .AllowMultiSelect = False
                .InitialView = msoFileDialogViewDetails
                .InitialFileName = gstrFilePath
                If .Show = 0 Then Exit Function
                strFilenamePath = .SelectedItems(1)
            End With
            gstrNewListFilename = FilenamePart(strFilenamePath)
            If Left(gstrNewListFilename, 5) = "ERROR" Then GoTo ExitError1
        Else
            strFilenamePath = gstrFilePath & gstrNewListFilename
        End If
        '   Set the temp worksheet name gstrListSheetName (temp because
        '       the worksheet does not exist yet) from the gstrNewListFilename
        gstrListSheetName = WorksheetFunction.Proper(Left(gstrNewListFilename, Len(gstrNewListFilename) - 4))
    Else
        If gstrPrevListFilename = "" Or _
            gstrPrevListFilename = "ASK USER ON IMPORT" Then
            With Application.FileDialog(msoFileDialogFilePicker)
                .AllowMultiSelect = False
                .InitialView = msoFileDialogViewDetails
                .InitialFileName = gstrFilePath
                If .Show = 0 Then Exit Function
                strFilenamePath = .SelectedItems(1)
            End With
            gstrPrevListFilename = FilenamePart(strFilenamePath)
            If Left(gstrPrevListFilename, 5) = "ERROR" Then GoTo ExitError1
        Else
            strFilenamePath = gstrFilePath & gstrPrevListFilename
        End If
        '   Set the worksheet name from the gstrListSheetName
        gstrListSheetName = WorksheetFunction.Proper(Left(gstrPrevListFilename, Len(gstrPrevListFilename) - 4))
    End If
'  Check for existing sheet name.
    If SheetExists(gstrListSheetName) Then GoTo ExitError2
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strFilenamePath, Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 720
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Name = gstrListSheetName
    ActiveSheet.Move before:=Worksheets("DataViewForm1")
    ' Add the new worksheet name to the combo box selection lists
    If Not AddSheetToCombo(bolIsNew) Then GoTo ExitError3
    ResetSourceDataCombo
ExitNormal:
    ImportFile = True
    Exit Function
ExitError1:
    If bolIsNew Then
        gvarMessage = MsgBox("Unable to Import file " _
            & vbCrLf & strFilenamePath & vbCrLf _
            & "Into a new worksheet named " & gstrNewList _
            & ".  Check User Valus.", vbOKOnly, "Unable to Import")
    Else
        gvarMessage = MsgBox("Unable to Import file " _
            & vbCrLf & strFilenamePath & vbCrLf _
            & "Into a new worksheet named " & gstrPrevList _
            & ".  Check User Valus.", vbOKOnly, "Unable to Import")
    End If
    GoTo ExitError
ExitError2:
    gvarMessage = MsgBox("Importing list would create " _
        & "duplicate worksheet names.  Delete the worksheet named:" _
        & vbCrLf & gstrListSheetName & vbCrLf _
        & "or provide a different name in the VariableValues worksheet. ", _
         vbOKOnly, "Unable to Import")
    GoTo ExitError
ExitError3:
    gvarMessage = MsgBox("Unable to add the Imported Data Worksheet Name " _
        & vbCrLf & gstrListSheetName & vbCrLf _
        & "to the combo box selection list. ", _
         vbOKOnly, "Unable to Add Worksheet Name")
ExitError:
    ImportFile = False
End Function


Function FormatRawImport(bolIsNew As Boolean) As Boolean

'
' FormatRawImport function
' Add Column Headings and Auto filter.
' Macro created 4 Feb 2002 by Dr. Meshkot
'
Dim strSheetName As String
Dim intCounter As Integer
On Error GoTo ExitError
    FormatRawImport = False
    If bolIsNew Then
        If Not SheetExists(gstrNewList) Then GoTo ExitError
        strSheetName = gstrNewList
    Else
        If Not SheetExists(gstrPrevList) Then GoTo ExitError
        strSheetName = gstrPrevList
    End If
    Sheets(strSheetName).Select
    Range("A1").Select
    Selection.EntireRow.Insert
'   set column heading and width
    For intCounter = 1 To cDataColCount
        With Range("A1").Offset(0, intCounter - 1)
            .Value = gstrColHeading(intCounter)
            .Font.Bold = True
            .Font.Size = 12
            .Interior.ColorIndex = colGrey
        End With
        Columns(intCounter).ColumnWidth = gintListColWidth
    Next
ExitNormal:
    FormatRawImport = True
    Exit Function
ExitError:
    FormatRawImport = False
    If bolIsNew Then
        gvarMessage = MsgBox("Unable to set column headings " _
            & "for worksheet named " & gstrNewList _
            & ".  Check User Values.", vbOKOnly, "Unable to Set Headings")
    Else
        gvarMessage = MsgBox("Unable to set column headings " _
            & "for worksheet named " & gstrPrevList _
            & ".  Check User Values.", vbOKOnly, "Unable to Set Headings")
    End If
End Function


Function FilenamePart(strFilePath As String) As String

Dim intCounter As Long
On Error GoTo ExitError
    FilenamePart = ""
    If Len(strFilePath) < 5 Then GoTo ExitError ' 5 characters, e.g. 1.csv
    For intCounter = Len(strFilePath) To 1 Step -1
        If Mid(strFilePath, intCounter, 1) = "\" Then
            FilenamePart = Right(strFilePath, Len(strFilePath) - intCounter)
            GoTo ExitNormal
        End If
    Next
ExitNormal:
    Exit Function
ExitError:
    FilenamePart = "ERROR in CSV filename/path"
End Function


'   Module CleanAndCompare

'   This module is for cleaning the data and comparing
'   new data with previous data.
'   By: Dr. M. A. Meshkot
'   12 Feb 2002
'   138011231353


Function CleanData(strSheetName As String) As Boolean

'   By: M. A. Meshkot
'   19 December 2001 00:50
' This routine is to clean the downloaded and imported data
' "Clean" here means removing entire rows where the specified column
'   contains invalid data
' For Salesserve Reference column, Valid data begin with SS.
Dim LastCellRow
    On Error GoTo ExitError
    CleanData = False
    If SheetExists(strSheetName) Then
        Sheets(strSheetName).Activate
    Else
        GoTo ExitError1
    End If
' Move to the column for which all records have a value
'   or otherwisr find the last row of data
    If gintDataCleanColumnRelative >= 0 Then
        Range("A2").Offset(0, gintDataCleanColumnRelative).Select
        ' Find the last cell in this column
        LastCellRow = Selection.End(xlDown).Row
    Else
        Range("A2").Select
        LastCellRow = ActiveCell.Cells.SpecialCells(xlCellTypeLastCell).Row
    End If
' Move to the data comparison column
    Range("A2").Offset(0, gintDataCompareColumnRelative).Select
'  Find the missing or invalid Sales references and delete that row.
'   Reduce the last row number whenever a row is deleted.
    Application.ScreenUpdating = False
    While ActiveCell.Row < LastCellRow
        If (CStr(ActiveCell.Value) = "") _
            Or (Left(CStr(ActiveCell.Value), 2) <> "SS") Then
            ActiveCell.EntireRow.Delete
            LastCellRow = LastCellRow - 1
            ActiveCell.Offset(-1, 0).Activate
        End If
        ActiveCell.Offset(1, 0).Activate
    Wend
    Application.ScreenUpdating = True
    Range("A1").Select
ExitNormal:
    CleanData = True
    Exit Function
ExitError1:
    gvarMessage = MsgBox("Unable to Clean Data because Worksheet " _
        & strSheetName _
        & " does not exist", vbOKOnly, "Clean Data Error")
ExitError:
    CleanData = False
    gvarMessage = MsgBox("Unable to Clean Data in worksheet " _
        & strSheetName _
        & ".  Check user values in " _
        & " VariableValues worksheet", vbOKOnly, "Data Clensing Error")
End Function



Sub MarkNewItemsByKey()

' To Mark records that are NEW compared to previous download
' In fact Two worksheets are compared here
' The worksheet names are taken from the New List and Prev List combo
' boxes on the data view form 1
Dim LookupResult As Variant
Dim OldListKey As Variant
Dim NewListKey As Variant
Dim LastCellInColAddress As Variant
Dim NewItemCount As Long
Dim lngScreenUpdatingCounter As Long
Dim lngLastDataRow As Long
Dim varCurrentZoom, varCurrentCellAddress
    On Error GoTo ExitError2
    lngScreenUpdatingCounter = 0
'  Check to see that we have 2 Sales lists imported.
    If gstrNewList = "" Or gstrPrevList = "" Then SetDefaultValues
    If (Not SheetExists(gstrNewList)) _
        Or (Not SheetExists(gstrPrevList)) Then
            GoTo ExitError1
    End If
    
'  Name the old list's Key column (or Field)
    Sheets(gstrPrevList).Activate
    Range("A2").Offset(0, gintDataCompareColumnRelative).Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
    ActiveWorkbook.Names.Add _
        Name:="PrevListKeyField", _
        RefersTo:="=" & ActiveSheet.Name & "!" _
        & Range("A2").Offset(0, gintDataCompareColumnRelative).Address _
        & ":" & LastCellInColAddress
'  Name the New list's Key column (or Field)
    Sheets(gstrNewList).Activate
    Range("A2").Offset(0, gintDataCompareColumnRelative).Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
    ActiveWorkbook.Names.Add _
        Name:="NewListKeyField", _
        RefersTo:="=" & ActiveSheet.Name & "!" _
        & Range("A2").Offset(0, gintDataCompareColumnRelative).Address _
        & ":" & LastCellInColAddress
'   Set display
    varCurrentZoom = ActiveWindow.Zoom
    varCurrentCellAddress = ActiveCell.Offset(0, 2).Address
    Range("A2:" & varCurrentCellAddress).Select
    ActiveWindow.Zoom = True
    Application.ScreenUpdating = False
    On Error GoTo ExitError
'   Use the VLookup worksheet function on the worksheet
'   and use its results to mark the row if it is a new item
'   The method is as follows:
    For Each NewListKey In Range(Names("NewListKeyField"))
        lngScreenUpdatingCounter = lngScreenUpdatingCounter + 1
        ' Show screen updating at the intervals selected by the user
        If lngScreenUpdatingCounter >= gIntShowScreenInterval Then
            Application.ScreenUpdating = True
            ' Scroll to the leftmost
            ActiveWindow.ScrollColumn = 1
            lngScreenUpdatingCounter = 0    ' Reset the counter
        Else
            Application.ScreenUpdating = False
        End If
        NewListKey.Activate
        ' The following IF statement prevents rechecking a cell that is
        '  already marked as a new Sales ref.
        If ActiveCell.Interior.ColorIndex = gMarkColourNew Then
            NewItemCount = NewItemCount + 1
            GoTo NextNewKeyList
        End If

        ' Move to the Temporary column and insert a VLOOKUP formula
        ActiveCell.Offset(0, gintTempColumnNumberRelative).Range("A1").Select
        Application.StatusBar = "Processing Row " & ActiveCell.Row
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-" & gintTempColumnNumberRelative _
            & "],PrevListKeyField,1,0)"
'       ReCalculate
        ' Error 2042 means the cell shows "#N/A" which means the KEY
        '    is new.  The IsNA function must be used to test for this value.
        ActiveSheet.Columns(ActiveCell.Column).Calculate
        If Application.WorksheetFunction.IsNA(ActiveCell.Value) Then
            ActiveSheet.Cells(ActiveCell.Row, 1 + gintMarkColumnNumberNewRelative).Select
            Selection.Interior.ColorIndex = gMarkColourNew
            NewItemCount = NewItemCount + 1
'   Return to the Temporary column, after marking the marked column,
'   and delete the temporary lookup formula.
            ActiveSheet.Cells(ActiveCell.Row, _
                1 + gintDataCompareColumnRelative _
                    + gintTempColumnNumberRelative).Select
        End If
        ActiveCell.Clear
NextNewKeyList:
    Next
    lngLastDataRow = ActiveCell.Row
    Application.ScreenUpdating = True
    ActiveWindow.Zoom = varCurrentZoom
    Range("A1").Activate
    ActiveWindow.ScrollColumn = 1
    If Not SheetExists("CompareResult") Then
        ActiveWorkbook.Sheets.Add
        ActiveSheet.Name = "CompareResult"
    End If
    Worksheets("CompareResult").Activate
    ActiveSheet.Range("A1").Select
    Selection.SpecialCells(xlCellTypeLastCell).Select
    ActiveCell.End(xlToLeft).Offset(1, 0).Select
    With ActiveCell
        .Offset(0, 0).Value = Now
        .Offset(0, 1).Value = "Worksheet"
        .Offset(0, 2).Value = gstrNewList
        .Offset(0, 3).Value = "Contained"
        .Offset(0, 4).Value = NewItemCount
        .Offset(0, 5).Value = "New Records out of "
        .Offset(0, 6).Value = lngLastDataRow - 1
        .Offset(0, 7).Value = "Records when Relative Column"
        .Offset(0, 8).Value = gintDataCompareColumnRelative
        .Offset(0, 9).Value = "was compared with Worksheet"
        .Offset(0, 10).Value = gstrPrevList
    End With
    ActiveSheet.Columns("A:K").AutoFit
    gvarMessage = MsgBox("The next message box will ask you to confirm that " _
        & "you wish to delete the old/previous data.  This is based on your " _
        & "selection in the Variable Values worksheet.", vbOKOnly, "Confirm Delete")
    If gbolDeleteOldList Then
        Worksheets(gstrPrevList).Delete
    End If
NormalExit:
    Exit Sub
ExitError1:
    gvarMessage = MsgBox("Unable to compare worksheet '" _
        & gstrNewList & "' with worksheet '" _
        & gstrPrevList & "' because one or both worksheet " _
        & "does not exist.  " _
        & "If data has not been imported during this session, then " _
        & "set the name of the New and Previous worksheets to be compared as a user " _
        & "variable in the VariableValues worksheet.", vbOKOnly, "Data Comparison Error")
    Exit Sub

ExitError2:
    gvarMessage = MsgBox("Unable to compare worksheet " _
        & gstrNewList & " with worksheet " _
        & gstrPrevList & " .  There was an error naming column ranges " _
        & "to compare.", vbOKOnly, "Data Comparison Error")
    Exit Sub

ExitError:
    gvarMessage = MsgBox("Unable to compare worksheet " _
        & gstrNewList & " with worksheet " _
        & gstrPrevList & " .  There was an error when comparing the data " _
        & "or marking new items or writing the compare results to " _
        & "worksheet CompareResult. Check the Variable Values, in particular:" _
        & " -gIntShowScreenInterval = " & gIntShowScreenInterval _
        & " -gintTempColumnNumberRelative(to key) = " & gintTempColumnNumberRelative _
        & " -gintMarkColumnNumberNewRelative(to column A) = " & gintMarkColumnNumberNewRelative _
        & " -gMarkColourNew = " & gMarkColourNew _
            , vbOKOnly, "Data Comparison Error")
End Sub


Function WorksheetList(intSelected As Integer) As String

Dim intCounter As Integer
    ' step through the worksheet names
    For intCounter = 1 To Worksheets.Count
        If Left(Worksheets(intCounter).Name, 3) = Left(gstrFilenameFormat, 3) Then
            If WorksheetList <> "" Then
                WorksheetList = WorksheetList & "," & Worksheets(intCounter).Name
            Else
                WorksheetList = Worksheets(intCounter).Name
            End If
        End If
    Next
End Function




'   Module Filter

'   This module is for filtering the data

'   By: Dr. M. A. Meshkot
'   23 April 2002
'   138102030851




Sub ApplyAdvancedFilter(strSheetToFilter As String, intFilter As Integer)

'
' ApplyAdvancedFilter
' Macro Created 23/04/2002 by Dr. Meshkot
'
    If SheetExists(strSheetToFilter) Then
        Worksheets(strSheetToFilter).Activate
    Else
        gvarMessage = MsgBox("Datalist Worksheet " & strSheetToFilter & " does not exist", vbOKOnly, _
        "Nothing to Filter")
        Exit Sub
    End If
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    Select Case intFilter
        Case Is = 1
            If Not SheetExists(gstrFilter1) Then
                gvarMessage = MsgBox("Missing Filter Worksheet " _
                & gstrFilter1 _
                & " Try initializing the data view form " _
                & "and check variable values worksheet", vbOKOnly, _
                "Missing Filter")
                Exit Sub
            End If
        Case Is = 2
            If Not SheetExists(gstrFilter2) Then
                gvarMessage = MsgBox("Missing Filter Worksheet " _
                & gstrFilter2 _
                & " Try initializing the data view form " _
                & "and check variable values worksheet", vbOKOnly, _
                "Missing Filter")
                Exit Sub
            End If
        Case Is = 3
            If Not SheetExists(gstrFilter3) Then
                gvarMessage = MsgBox("Missing Filter Worksheet " _
                & gstrFilter3 _
                & " Try initializing the data view form " _
                & "and check variable values worksheet", vbOKOnly, _
                "Missing Filter")
                Exit Sub
            End If
    End Select
    
    Select Case intFilter
    Case Is = 1
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets(gstrFilter1).UsedRange, Unique:=False
        Worksheets("DataViewForm1").txtFilteredCount _
            = WorksheetFunction.DCountA(Sheets(strSheetToFilter).UsedRange, _
                3, Sheets(gstrFilter1).UsedRange)
    Case Is = 2
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets(gstrFilter2).UsedRange, Unique:=False
        Worksheets("DataViewForm1").txtFilteredCount _
            = WorksheetFunction.DCountA(Sheets(strSheetToFilter).UsedRange, _
                3, Sheets(gstrFilter2).UsedRange)
    Case Is = 3
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets(gstrFilter3).UsedRange, Unique:=False
        Worksheets("DataViewForm1").txtFilteredCount _
            = WorksheetFunction.DCountA(Sheets(strSheetToFilter).UsedRange, _
                3, Sheets(gstrFilter3).UsedRange)
    Case Is = 4
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets(gstrFilter4).UsedRange, Unique:=False
        Worksheets("DataViewForm1").txtFilteredCount _
            = WorksheetFunction.DCountA(Sheets(strSheetToFilter).UsedRange, _
                3, Sheets(gstrFilter4).UsedRange)
    End Select
End Sub


Sub CopyMarkedRecords()

'   By: M. A. Meshkot
'   26 April 2002 00:25
'   Set the worksheet name for copy destination
Dim strFirstCellInColAddress As String
Dim strLastCellInColAddress As String
Dim strAttachFilePath As String
Dim intCounter As Integer
Dim CellObject
'   Check that the source and destination worksheets exists
'* suspended 29/4/2002 17:22    gstrSourceDataWorksheetName = Worksheets("DataViewForm1").cboSourceDataWorksheet.Value
    If Not SheetExists(gstrSourceDataWorksheetName) Then GoTo ExitError1
    If Not SheetExists(gstrSelectedList) Then GoTo ExitError2
' Move to the Selected marked column on the Source worksheet
    Worksheets(gstrSourceDataWorksheetName).Activate
    strFirstCellInColAddress = Range("A1").Offset(0, gintMarkColumnNumberSelectRelative).Address
    Range(strFirstCellInColAddress).Select
' Find the last row (cell) of the Marked Column on the source worksheet
    strLastCellInColAddress = Selection.End(xlDown).Address
'  Find the Marked (highlighted) cells in the mark column on the source worksheet
    For Each CellObject In Range(strFirstCellInColAddress & ":" & strLastCellInColAddress)
        If CellObject.Interior.ColorIndex = gMarkColourSelect Then
            CellObject.Activate
' Say that the Marked record has been (is about to be) copied to the Selection worksheet.
            ActiveCell.Interior.ColorIndex = gMarkColourCopied
' Get the attachment address from the attachment column on the source data worksheet
            strAttachFilePath = ActiveCell.Offset(0, gintAttachmentAdsColNumberRel)
' Move to the first col of this source worksheet row (first field of this
'   marked record) and select to the last column of data
            ActiveCell.Offset(0, -gintMarkColumnNumberSelectRelative).Range(Cells(1, 1), Cells(1, cDataColCount)).Select
            Selection.Copy  ' from the source worksheet
            Sheets(gstrSelectedList).Activate  ' select the destination worksheet
            ActiveSheet.Cells(1, gintPasteColumnNumber).Select    ' go to the first cell in the destination column
' Use control down-arrow to get to the last row and then move down 1 more
            Selection.End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
' Scrap the copy selection
            Application.CutCopyMode = False
' Add the attachment FilePath as the last column
            ActiveCell.Offset(0, cDataColCount - gintMarkColumnNumberSelectRelative + 1).Value = strAttachFilePath

' Move back 2 column before the first data column on this row to write-in the date of Selection.
            ActiveCell.Offset(0, gintMarkColumnNumberSelectRelative - 1 - 2).Value = Now()
' Move back 1 column before the first data column on this row to write-in the Source Data name.
            ActiveCell.Offset(0, gintMarkColumnNumberSelectRelative - 1 - 1).Value = gstrSourceDataWorksheetName
' Add a column for the FollowUp Date.
            ActiveCell.Offset(0, cDataColCount + 2).Value = Date + gintEmail1Email2Delay
            ActiveCell.Offset(0, cDataColCount + 2).Interior.ColorIndex = gMarkColourBeforeEmail2
' Indicate by colour that email has not been sent yet.
            ActiveCell.Offset(0, gintMarkColumnNumberSelectRelative).Interior.ColorIndex = gMarkColourCopied
' Return to the item list worksheet.
            ActiveCell.End(xlToLeft).Activate
            Sheets(gstrSourceDataWorksheetName).Activate
        End If
    Next
    ActiveCell.End(xlToLeft).Activate
ExitNormal:
    Exit Sub
ExitError1:
    gvarMessage = MsgBox("Selected source data Worksheet " & gstrSourceDataWorksheetName _
    & " does not exist", vbOKOnly, _
    "Misssing Worksheet")
    Exit Sub
ExitError2:
    gvarMessage = MsgBox("Copy destination Worksheet " & gstrSelectedList _
    & " does not exist.  Check variable values", vbOKOnly, _
    "Misssing Worksheet")
    
End Sub




'   SendEmails Module

'   This module will send 2 emails at defined intervals with provocation
'   The email text is taken from the VariableValue worksheet.
'   When user values are left blank (empty string),
'   then the default values are used.
'   Dr. M. A. Meshkot   26 April 2002
'   1380206
Option Explicit



Sub SendEmailOne()

'   To send email 1 for selected items copied to the Selected Worksheet
'   for which Email1 has not been sent yet.
'   The selection criteria is the colour of the marked column.
'   The colour and the column are both variables in the VariableValue worksheet
'   The method is:
'   1.  Find rows with selected colour in the selected column.
'   2.  Create email details from that row.
'
' For columns we have:
' <Selection Date><Source><Data columns><Attachment Address><Email2Date><Response>
'
Dim CellObject, LastRowAddress
' These are the fields which makeup one record of selected rows of imported data
Dim strDataCell(1 To 50) As String
Dim strHTMLBody(1 To 100) As String
Dim strDataRecordAndLabel As String   ' One record of the selected items
Dim strEmailBody As String
Dim strEmailSubject As String
Dim strEmailAddress As String
Dim strEmailTo As String
Dim EmailAttachment As String
Dim strFirstCellInColAddress As String
Dim strLastCellInColAddress As String
Const cMaxEmailBatchSize = 15
Const Para = vbCrLf + vbCrLf
Const NewLine = vbCrLf
Const HTMLBreak = "<br>"
Dim objEmailOne(1 To cMaxEmailBatchSize)
Dim intCounter As Integer
Dim objNS, objInBox
Dim objOL As Outlook.Application
Dim intEmailCounter As Integer

    Set objOL = New Outlook.Application
    Set objNS = objOL.GetNameSpace("MAPI")
    Set objInBox = objNS.GetDefaultFolder(olFolderInbox)
    intEmailCounter = 1
'  Reset Variable Values
    SetVariableValues
    Sheets(gstrSelectedList).Activate
' Move to the title column, which is marked
    strFirstCellInColAddress = _
      Range("A1").Offset(0, gintPasteColumnNumber - 1 + gintMarkColumnNumberSelectRelative).Address
    Range(strFirstCellInColAddress).Select
' Find the last cell of this Selected List worksheet marked column
    strLastCellInColAddress = Selection.End(xlDown).Address
'  Find the differently highlighted cells in the marked column
    For Each CellObject In Range(strFirstCellInColAddress & ":" & strLastCellInColAddress)
        If (CellObject.Interior.ColorIndex = gMarkColourCopied) _
            And (intEmailCounter <= gintEmailBatchSize) Then
'  Create new email object
            Set objEmailOne(intEmailCounter) = objOL.CreateItem(olMailItem)
            strEmailBody = ""
' Activate the marked cell
            CellObject.Activate
' Assign values to recreate the selected records with labels as in column headings
            strDataCell(1) = gstrColHeading(1) & ":  " & ActiveCell.Offset(0, -1).Value
            strDataCell(2) = gstrColHeading(2) & ":  " & ActiveCell.Offset(0, 0).Value
                objEmailOne(intEmailCounter).Subject = ActiveCell.Offset(0, 0).Value
            strDataCell(3) = gstrColHeading(3) & ":  " & ActiveCell.Offset(0, 1).Value
            strDataCell(4) = gstrColHeading(4) & ":  " & ActiveCell.Offset(0, 2).Value
            strDataCell(5) = gstrColHeading(5) & ":  " & ActiveCell.Offset(0, 3).Value
            strDataCell(6) = gstrColHeading(6) & ":  " & ActiveCell.Offset(0, 4).Value
            strDataCell(7) = gstrColHeading(7) & ":  " & ActiveCell.Offset(0, 5).Value
            strDataCell(8) = gstrColHeading(8) & ":  " & ActiveCell.Offset(0, 6).Value
            strDataCell(9) = gstrColHeading(9) & ":  " & ActiveCell.Offset(0, 7).Value
                strEmailTo = ActiveCell.Offset(0, 7).Value
            strDataCell(10) = gstrColHeading(10) & ":  " & ActiveCell.Offset(0, 8).Value
            strDataCell(11) = gstrColHeading(11) & ":  " & ActiveCell.Offset(0, 9).Value
            strEmailAddress = ActiveCell.Offset(0, 10).Value
' Set the email address
                If Len(strEmailAddress) > 5 Then ' 5= minimum email address length
                    strDataCell(12) = gstrColHeading(12) & ":  " & strEmailAddress
                    objEmailOne(intEmailCounter).Recipients.Add (strEmailAddress)
                Else
                     gvarMessage = MsgBox("Item at row " _
                        & ActiveCell.Offset(0, 10).Row _
                        & " Does not have an email address" & vbCrLf _
                        & " Will mark and continue", vbOKOnly, "No Email Address")
                    objEmailOne(intEmailCounter).Delete
                     ActiveCell.Interior.ColorIndex = 7
                    GoTo NextCellObject
                End If
' set the last 2 columns (web address and reference for Salesserve files)
            strDataCell(13) = gstrColHeading(13) & ":  " & ActiveCell.Offset(0, 11).Value
            strDataCell(14) = gstrColHeading(14) & ":  " & ActiveCell.Offset(0, 12).Value
' Set the email subject
                objEmailOne(intEmailCounter).Subject = _
                                "Invoice for: " _
                                & objEmailOne(intEmailCounter).Subject _
                                & " - " & strDataCell(14)
' Set the email attachment address
            EmailAttachment = ActiveCell.Offset(0, gintAttachmentAdsColNumberRel).Value
'  The full Selected Record (Data Item) is the sum of the Data Cells
            strDataRecordAndLabel = ""
            For intCounter = 1 To cDataColCount
                strDataRecordAndLabel = strDataRecordAndLabel & strDataCell(intCounter) & NewLine
            Next
'  Now create the email body
            strEmailBody = ""
            Debug.Print "--------------------------------"; Now
            For intCounter = 1 To cEmail1Lines
                Debug.Print intCounter, gstrEmail1HTMLBodyLine(intCounter)
                If gstrEmail1HTMLBodyLine(intCounter) = "[Recipient Name]" Then
                    strEmailBody = strEmailBody & strEmailTo
                    GoTo NextLineOfEmail
                ElseIf gstrEmail1HTMLBodyLine(intCounter) = "[Selected Item]" Then
                    strEmailBody = strEmailBody & strDataRecordAndLabel
                    GoTo NextLineOfEmail
                Else
                    strEmailBody = strEmailBody & gstrEmail1HTMLBodyLine(intCounter)
                End If
NextLineOfEmail:
            Next
            objEmailOne(intEmailCounter).Body = ""
            objEmailOne(intEmailCounter).HTMLBody = ""
            objEmailOne(intEmailCounter).HTMLBody = strEmailBody
'  Add the attachment
            On Error Resume Next
            objEmailOne(intEmailCounter).Attachments.Add (EmailAttachment)
            objEmailOne(intEmailCounter).Categories = "MAM750 Sales Search"
            On Error GoTo 0
'   Display email and indicate (by colour) that it was sent out of Excel.
            objEmailOne(intEmailCounter).Display
            ActiveCell.Interior.ColorIndex = gMarkColourAfterEmail1
'   Increment the email counter
            intEmailCounter = intEmailCounter + 1
            
        End If
NextCellObject:
    Next
End Sub


Sub SendEmailTwo()

'   To send follow-up email 2 for marked items copied to the Selected Worksheet
'   for which Email2 has not been sent yet.
'   The follow-up date is set when records are copied to the Selected worksheet.
'   The selection criteria is the colour of the follow-up column.
'   The colour is a variable gMarkColourBeforeEmail2 in the VariableValue worksheet
'   The method is:
'   1.  Find rows with selected colour in the selected column.
'   2.  Create email details from that row.
'
' For columns we have:
' <Selection Date><Source><Data columns><Attachment Address><Email2Date><Response>
'
Dim CellObject, LastRowAddress
' These are the fields which makeup one record of selected rows of imported data
Dim strDataCell(1 To 50) As String
Dim strHTMLBody(1 To 50) As String
Dim strDataRecordAndLabel As String   ' One record of the selected items
Dim strEmailBody As String
Dim strEmailSubject As String
Dim strEmailAddress As String
Dim strEmailTo As String
Dim strEmail1Date As String
Dim EmailAttachment As String   ' not used for follow-up
Dim strFirstCellInColAddress As String
Dim strLastCellInColAddress As String
Dim dblLastRowInCol As Double
Const cMaxEmailBatchSize = 15
Const Para = vbCrLf + vbCrLf
Const NewLine = vbCrLf
Const HTMLBreak = "<br>"
Dim objEmailTwo(1 To cMaxEmailBatchSize)
Dim intCounter As Integer
Dim objNS, objInBox
Dim objOL As Outlook.Application
Dim intEmailCounter As Integer

    Set objOL = New Outlook.Application
    Set objNS = objOL.GetNameSpace("MAPI")
    Set objInBox = objNS.GetDefaultFolder(olFolderInbox)
    intEmailCounter = 1
'  Reset Variable Values
    SetVariableValues
    If SheetExists(gstrSelectedList) Then
        Sheets(gstrSelectedList).Activate
    Else
       gvarMessage = MsgBox("There is no selected records worksheet named " _
        & gstrSelectedList, vbOKOnly, "Missing Worksheet")
        Exit Sub
    End If
' Move to the title column, which is marked
    strFirstCellInColAddress = _
      Range("A1").Offset(0, cFollowUpColRelative).Address
    Range(strFirstCellInColAddress).Select
' Find the last row of this Selected List worksheet follow-up column
'   Since the follow-up date column is the last column, then the last cell
'   in the used range will be the last cell in the follow-up column.
'   However, I must consider that other columns may be added in the future.
'   To make this consideration, I will use the Last Row Number in the
'   follow-up column, instead of the LastCellInColumn.
    dblLastRowInCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'  Find the differently highlighted cells in the marked column
    For Each CellObject In Range(strFirstCellInColAddress & ":" _
        & Range(strFirstCellInColAddress).Offset(dblLastRowInCol, 0).Address)
        If (CellObject.Interior.ColorIndex = gMarkColourBeforeEmail2) _
            And (intEmailCounter <= gintEmailBatchSize) _
            And (CellObject.Value <= Date) Then
'  Create new email object
            Set objEmailTwo(intEmailCounter) = objOL.CreateItem(olMailItem)
            strEmailBody = ""
' Activate the marked cell
            CellObject.Activate
' Assign values to recreate the selected records with labels as in column headings
            strDataCell(1) = gstrColHeading(1) & ":  " & ActiveCell.Offset(0, -16).Value
            strDataCell(2) = gstrColHeading(2) & ":  " & ActiveCell.Offset(0, -15).Value
                objEmailTwo(intEmailCounter).Subject = ActiveCell.Offset(0, -15).Value
            strDataCell(3) = gstrColHeading(3) & ":  " & ActiveCell.Offset(0, -14).Value
            strDataCell(4) = gstrColHeading(4) & ":  " & ActiveCell.Offset(0, -13).Value
            strDataCell(5) = gstrColHeading(5) & ":  " & ActiveCell.Offset(0, -12).Value
            strDataCell(6) = gstrColHeading(6) & ":  " & ActiveCell.Offset(0, -11).Value
            strDataCell(7) = gstrColHeading(7) & ":  " & ActiveCell.Offset(0, -10).Value
            strDataCell(8) = gstrColHeading(8) & ":  " & ActiveCell.Offset(0, -9).Value
            strDataCell(9) = gstrColHeading(9) & ":  " & ActiveCell.Offset(0, -8).Value
                strEmailTo = ActiveCell.Offset(0, -8).Value
            strDataCell(10) = gstrColHeading(10) & ":  " & ActiveCell.Offset(0, -7).Value
            strDataCell(11) = gstrColHeading(11) & ":  " & ActiveCell.Offset(0, -6).Value
            strEmailAddress = ActiveCell.Offset(0, -5).Value
' Set the email address
                If Len(strEmailAddress) > 5 Then ' 5= minimum email address length
                    strDataCell(12) = gstrColHeading(12) & ":  " & strEmailAddress
                    objEmailTwo(intEmailCounter).Recipients.Add (strEmailAddress)
                Else
                     gvarMessage = MsgBox("Item at row " _
                        & ActiveCell.Row _
                        & " Does not have an email address" & vbCrLf _
                        & " Will mark and continue", vbOKOnly, "No Email Address")
                    objEmailTwo(intEmailCounter).Delete
                     ActiveCell.Interior.ColorIndex = 7
                    GoTo NextCellObject
                End If
' set the last 2 columns (web address and reference for Salesserve files)
            strDataCell(13) = gstrColHeading(13) & ":  " & ActiveCell.Offset(0, -4).Value
            strDataCell(14) = gstrColHeading(14) & ":  " & ActiveCell.Offset(0, -3).Value
' Set the date of Email1
            strEmail1Date = Left(CStr(ActiveCell.Offset(0, -18).Value), 10)
' Set the email subject
                objEmailTwo(intEmailCounter).Subject = _
                                "Follow-up for: " _
                                & objEmailTwo(intEmailCounter).Subject _
                                & " - " & strDataCell(14)
' Set the email attachment address
'            EmailAttachment = ActiveCell.Offset(0, gintAttachmentAdsColNumberRel).Value
'  The full Selected Record (Data Item) is the sum of the Data Cells
            strDataRecordAndLabel = ""
            For intCounter = 1 To cDataColCount
                strDataRecordAndLabel = strDataRecordAndLabel & strDataCell(intCounter) & NewLine
            Next
'  Now create the email body
            strEmailBody = ""
            Debug.Print "--------------------------------"; Now
            For intCounter = 1 To cEmail2Lines
                Debug.Print intCounter, gstrEmail2HTMLBodyLine(intCounter)
                If gstrEmail2HTMLBodyLine(intCounter) = "[Recipient Name]" Then
                    strEmailBody = strEmailBody & strEmailTo
                    GoTo NextLineOfEmail
                ElseIf gstrEmail2HTMLBodyLine(intCounter) = "[Email1Date]" Then
                    strEmailBody = strEmailBody & strEmail1Date
                    GoTo NextLineOfEmail
                Else
                    strEmailBody = strEmailBody & gstrEmail2HTMLBodyLine(intCounter)
                End If
NextLineOfEmail:
            Next
            objEmailTwo(intEmailCounter).Body = ""
            objEmailTwo(intEmailCounter).HTMLBody = ""
            objEmailTwo(intEmailCounter).HTMLBody = strEmailBody
'  Add the attachment
            On Error Resume Next
'            objEmailTwo(intEmailCounter).Attachments.Add (EmailAttachment)
            objEmailTwo(intEmailCounter).Categories = "MAM750 Sales Search"
            On Error GoTo 0
'   Display email and indicate (by colour) that it was sent out of Excel.
            objEmailTwo(intEmailCounter).Display
            ActiveCell.Interior.ColorIndex = gMarkColourAfterEmail2
'   Increment the email counter
            intEmailCounter = intEmailCounter + 1
            
        End If
NextCellObject:
    Next
End Sub



Sub ImportSalesListToday()

'   Import a .csv Sales file
    ImportSalesFile (strSalesListToday)
'   Format the file to set the column headers, col. width and ACCESS filter.
    FormatRawImport (strSalesListToday)
'   Clean the Sales list
    CleanSaleslistMethod (strSalesListToday)
End Sub


Sub ImportSalesListPrev()

'   Import a .csv Sales file
    ImportSalesFile (strSalesListPrev)
'   Format the file to set the column headers, col. width and ACCESS filter.
    FormatRawImport (strSalesListPrev)
'   Clean the Sales list
    CleanSaleslistMethod (strSalesListPrev)
End Sub


Sub Import2SalesLists()

    ImportSalesList2DaysOld
    ImportSalesList1DayOld
End Sub



Sub ImportSalesList2DaysOld()

'   By: Dr. M. A. Meshkot  29 Nov 2001 02:15
'  To import the Sales file from 2 days ago.
'  First calculate the logical file name SalesYYMMDD.CSV
Dim strSaleslistOldFile As String
    strSaleslistOldFile = "Sales" & Format(Format(Date - 2, "yymmdd"), "000000") & ".csv"
    strSaleslistOldFile = strFilePath & strSaleslistOldFile
'   Import a .csv Sales file
    Call ImportNamedSalesFile(strSaleslistOldFile, strSalesListPrev)
'   Format the file to set the column headers, col. width and ACCESS filter.
    FormatRawImport (strSalesListPrev)
End Sub


Sub ImportSalesList1DayOld()

'  To import the Sales file from 2 days ago.
'  First calculate the logical file name SalesYYMMDD.CSV
Dim strSaleslistOldFile As String
    strSaleslistOldFile = "Sales" & Format(Format(Date - 1, "yymmdd"), "000000") & ".csv"
    strSaleslistOldFile = strFilePath & strSaleslistOldFile
'   Import a .csv Sales file
    Call ImportNamedSalesFile(strSaleslistOldFile, strSalesListToday)
'   Format the file to set the column headers, col. width and ACCESS filter.
    FormatRawImport (strSalesListToday)
End Sub


Sub ImportSalesFile(strSalesSheetName As String)

'
' Import Sales Data File Macro
' Import Sales File CSV Data
' Macro recorded 15/10/2001 by Dr. Meshkot
'
Dim strSalesfile As String

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .InitialView = msoFileDialogViewDetails
    .InitialFileName = "\\Data2002A\Internet\SalesSearch"
    If .Show = 0 Then Exit Sub
    strSalesfile = .SelectedItems(1)
End With

Debug.Print Now(); "file name is: "; strSalesfile


'
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strSalesfile, Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 720
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Name = strSalesSheetName
End Sub


Sub ImportNamedSalesFile(strNamedSalesFile As String, strSalesSheetName As String)

'
' Import Sales Data File Macro
' Import Sales File CSV Data
' Macro recorded 15/10/2001 by Dr. Meshkot
'
Dim strSalesfile As String
Debug.Print Now(); "Import file name is: "; strNamedSalesFile, "Worksheet Name is: "; strSalesSheetName


'
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strNamedSalesFile, Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 720
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Name = strSalesSheetName
End Sub



'Sub FormatRawImport(strSheetName As String)

'
' FormatRawImport Macro
' Add Column Headings and Auto filter.
' Macro recorded 15/10/2001 by Dr. Meshkot
'

'    If Not SheetExists(strSheetName) Then Exit Sub
'    Sheets("Headers").Select
'    Rows("1:1").Select
'    Selection.Copy
'    Sheets(strSheetName).Select
'    Rows("1:1").Select
'    Selection.Insert Shift:=xlDown
'    Cells.Select
'    Selection.ColumnWidth = 9
'    Range("B1").Select
'    Selection.AutoFilter Field:=2, Criteria1:="=*access*", Operator:=xlAnd
'End Sub


Sub CopyToApplied()

'   By: M. A. Meshkot
'   17 October 2001 01:53
'
    If Not SheetExists(strSalesListToday) Then Exit Sub
    Sheets(strSalesListToday).Activate
' Move to the title column
    Range("B2").Select
' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
'  Find the highlighted cells in Column B
    For Each CellObject In Range("B1:" & LastCellInColAddress)
        If CellObject.Interior.ColorIndex = 6 Then
            CellObject.Activate
            ActiveCell.Interior.ColorIndex = 44
' Move to the first col of this row and select to col.N
            ActiveCell.Offset(0, -1).Range("A1:N1").Select
            Selection.Copy
            Sheets("AppliedTo").Activate
            Range("B2").Select
' Use control down-arrow to get to the last row and then move down 1 more
            Selection.End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
' Scrap the copy selection
            Application.CutCopyMode = False
' Move to col A of this row to write-in the date of Invoice.
            Selection.Offset(0, -1).Activate
            ActiveCell.Value = Now()
' Move to col Q of this row to write-in the FollowUp Date.
            Selection.Offset(0, 16).Activate
            ActiveCell.Value = Date + 2
            ActiveCell.Interior.ColorIndex = 38
' Return to the Saleslist sheet and move to the right of the last found cell.
            Sheets(strSalesListToday).Activate
            
        End If
    Next
    
End Sub


Sub SendEmailInvoice()

'   To send email Invoice for those Sales that have been
'   copied to the AppliedTo worksheet, but not yet applied.
'   The selection criteria is the colour of the Title column.
'   Which must be Orange.

'   The method is:
'   1.  Find rows of Sales details with orange colour in the title.
'   2.  Create email details from that row.
'
Dim CellObject, LastRowAddress
Dim strSalesLine(1 To 50) As String
Dim strHTMLBody(1 To 100) As String
Dim strSalesDetail As String
Dim strEmailBody As String
Dim strEmailSubject As String
Dim strEmailAddress As String
Dim strEmailTo As String
Dim strAboutCV As String
Const Para = vbCrLf + vbCrLf
Const NewLine = vbCrLf
Const HTMLBreak = "<br>"
Const EmailAttachment = "\\Data2002A\Sales2002\SalesAnalysis\Invoice.rtf"
Dim intCounter As Integer
Dim MsgReply
Dim objNS, objInBox
Dim objSalesEmail(1 To 10) ' Number of emails at a time
Dim objOL As Outlook.Application
Dim intEmailCounter As Integer
Set objOL = New Outlook.Application
Set objNS = objOL.GetNameSpace("MAPI")
Set objInBox = objNS.GetDefaultFolder(olFolderInbox)

'  Define HTML Body for Email
strHTMLBody(1) = "<HTML><HEAD>"
strHTMLBody(2) = "<TITLE>Sales Email from the Accounts Manager Ali Meshkot</TITLE>"
strHTMLBody(3) = "<META http-equiv=Content-Type content='text/html; charset=utf-8'></HEAD>"
strHTMLBody(4) = "<BODY bgColor=#99ccff LeftMargin=50>"
strHTMLBody(5) = "<BASEFONT='4'></basefont>"
strHTMLBody(6) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffff00'>Dear "
strHTMLBody(7) = "</span> </b></p>"
strHTMLBody(8) = "<p><b>I enclose a copy invoice in response to the "
strHTMLBody(9) = "request you made below.&nbsp Please contact me regarding the progress "
strHTMLBody(10) = "of this Invoice. </p><p>Regards</FONT></b></p>"
strHTMLBody(11) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffff00'>Ali Meshkot."
strHTMLBody(12) = "</span></font> </b></p>"
strHTMLBody(13) = ""
strHTMLBody(14) = ""
strHTMLBody(15) = ""
strHTMLBody(16) = ""
strHTMLBody(17) = ""
strHTMLBody(18) = ""
strHTMLBody(19) = ""
strHTMLBody(20) = ""
strHTMLBody(21) = ""
strHTMLBody(22) = ""
strHTMLBody(23) = ""
strHTMLBody(24) = "---------- Your Request----------</b></p></span>"
strHTMLBody(25) = "<pre>"
strHTMLBody(26) = ""
strHTMLBody(27) = ""
strHTMLBody(28) = ""
strHTMLBody(29) = ""
strHTMLBody(30) = "</BODY></HTML>"
strHTMLBody(31) = ""
strHTMLBody(32) = ""
strHTMLBody(33) = ""
intEmailCounter = 1

    Sheets("AppliedTo").Activate
' Move to the title column, which is marked
    Range("C2").Select
' Find the last cell in this column
    LastRowAddress = Selection.End(xlDown).Address
'  Find the differently highlighted cells in Column B
    For Each CellObject In Range("B1:" & LastRowAddress)
        If (CellObject.Interior.ColorIndex = 44) _
            And (intEmailCounter <= 6) Then
            Set objSalesEmail(intEmailCounter) = objOL.CreateItem(olMailItem)
            strEmailBody = ""
'  Reset strings 6 and 29 in case the last run was aborted
            strHTMLBody(6) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffff00'>Dear "
            strHTMLBody(29) = ""
            CellObject.Activate
' Move to the second col of this row
            strSalesLine(1) = "Type:  " & ActiveCell.Offset(0, -1).Value
            strSalesLine(2) = "Title:  " & ActiveCell.Offset(0, 0).Value
                objSalesEmail(intEmailCounter).Subject = _
                                    ActiveCell.Offset(0, 0).Value
            strSalesLine(3) = "Service Details:  " & ActiveCell.Offset(0, 1).Value
'  Break the length of the Details line to 80 col.
            strSalesLine(4) = "Location:  " & ActiveCell.Offset(0, 2).Value
            strSalesLine(5) = "Start:  " & ActiveCell.Offset(0, 3).Value
            strSalesLine(6) = "Duration:  " & ActiveCell.Offset(0, 4).Value
            strSalesLine(7) = "Pay:  " & ActiveCell.Offset(0, 5).Value
            strSalesLine(8) = "Agency:  " & ActiveCell.Offset(0, 6).Value
            strSalesLine(9) = "Contact:  " & ActiveCell.Offset(0, 7).Value
                strEmailTo = ActiveCell.Offset(0, 7).Value
            strSalesLine(10) = "Tel:  " & ActiveCell.Offset(0, 8).Value
            strSalesLine(11) = "Fax:  " & ActiveCell.Offset(0, 9).Value
            strEmailAddress = ActiveCell.Offset(0, 10).Value
                If Len(strEmailAddress) > 5 Then ' 5= minimum email address length
                    strSalesLine(12) = "Email:  " & strEmailAddress
                    objSalesEmail(intEmailCounter).Recipients.Add (strEmailAddress)
                Else
                     MsgReply = MsgBox("Sales at row " _
                        & ActiveCell.Offset(0, 10).Row _
                        & " Does not have an email address" & vbCrLf _
                        & " Will mark and continue", vbOKOnly, "No Email Address")
                    objSalesEmail(intEmailCounter).Delete
                     ActiveCell.Interior.ColorIndex = 7
                    GoTo NextCellObject
                End If
            strSalesLine(13) = "Web:  " & ActiveCell.Offset(0, 11).Value
            strSalesLine(14) = "Reference  " & ActiveCell.Offset(0, 12).Value
                objSalesEmail(intEmailCounter).Subject = _
                                "Invoice for: " _
                                & objSalesEmail(intEmailCounter).Subject _
                                & " - " & strSalesLine(14)
'  The Sales details is the sum of the Sales lines
            strSalesDetail = ""
            For intCounter = 1 To 14
                strSalesDetail = strSalesDetail & strSalesLine(intCounter) & NewLine
            Next
            strSalesDetail = strSalesDetail & "<br></pre></p>"
'  Add the email recipient name and Sales details
            strHTMLBody(6) = strHTMLBody(6) & strEmailTo
            strHTMLBody(29) = strHTMLBody(29) & strSalesDetail
'  Now create the email body
            For intCounter = 1 To 50
                strEmailBody = strEmailBody & strHTMLBody(intCounter)
            Next
            objSalesEmail(intEmailCounter).Body = ""
            objSalesEmail(intEmailCounter).HTMLBody = ""
            objSalesEmail(intEmailCounter).HTMLBody = strEmailBody
'  Add the attachment
            objSalesEmail(intEmailCounter).Attachments.Add (EmailAttachment)
            objSalesEmail(intEmailCounter).Categories = "MAM750 Sales Search"
            objSalesEmail(intEmailCounter).Display
' This line causes an error, therefore use an array variable       objSalesEmail = Nothing
            CellObject.Interior.ColorIndex = 6
            intEmailCounter = intEmailCounter + 1
            
        End If
NextCellObject:
    Next
End Sub



Sub SendFollowUpEmail()

'   To send follow-up emails for those Sales that have a follow-up date
'   The follow-up date is set by default to 2 days after the Invoice
'       date shown on the AppliedTo worksheet.
'   The selection criteria is the colour of the new FollowUp column.
'   Which must be Orange to send the follow-up email.
'   During the email sending process, the colour is reset to indicate
'       that the follow-up has been sent.

'   The method is:
'   1.  Find rows of Sales details with orange colour in the title.
'   2.  Create email details from that row.
'
Dim CellObject, LastRowAddress, DateApplied
Dim strSalesLine(1 To 50) As String
Dim strHTMLBody(1 To 100) As String
Dim strSalesDetail As String
Dim strEmailBody As String
Dim strEmailSubject As String
Dim strEmailAddress As String
Dim strEmailTo As String
Dim strAboutCV As String
Const Para = vbCrLf + vbCrLf
Const NewLine = vbCrLf
Const HTMLBreak = "<br>"
Const EmailAttachment = "\\Data2002A\Sales2002\Ali Meshkot.htm"
Dim intCounter As Integer
Dim MsgReply
Dim objNS, objInBox
Dim objFollowUpEmail(1 To 10) ' Number of emails at a time
Dim objOL As Outlook.Application
Dim intEmailCounter As Integer
Set objOL = New Outlook.Application
Set objNS = objOL.GetNameSpace("MAPI")
Set objInBox = objNS.GetDefaultFolder(olFolderInbox)

'  Define HTML Body for Email
strHTMLBody(1) = "<HTML><HEAD>"
strHTMLBody(2) = "<TITLE>Follow-up Email from the Accounts Manager Ali Meshkot</TITLE>"
strHTMLBody(3) = "<META http-equiv=Content-Type content='text/html; charset=utf-8'></HEAD>"
strHTMLBody(4) = "<BODY bgColor=#99ffcc LeftMargin=50>"
strHTMLBody(5) = "<BASEFONT='4'></basefont>"
strHTMLBody(6) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffcccc'>Dear "
strHTMLBody(7) = "</span> </b></p>"
strHTMLBody(8) = "<p><b>I sent you an email regarding the above invoice on "
strHTMLBody(9) = ", with my contact details enclosed.&nbsp However, I have not received any feedback "
strHTMLBody(10) = "from you yet.  Please let me know the current state of this Invoice. </p><p>Regards</FONT></b></p>"
strHTMLBody(11) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffcccc'>Ali Meshkot."
strHTMLBody(12) = "</span></font> </b></p>"
strHTMLBody(13) = ""
strHTMLBody(14) = ""
strHTMLBody(15) = ""
strHTMLBody(16) = ""
strHTMLBody(17) = ""
strHTMLBody(18) = ""
strHTMLBody(19) = ""
strHTMLBody(20) = ""
strHTMLBody(21) = ""
strHTMLBody(22) = ""
strHTMLBody(23) = ""
strHTMLBody(24) = ""
strHTMLBody(25) = ""
strHTMLBody(26) = ""
strHTMLBody(27) = ""
strHTMLBody(28) = ""
strHTMLBody(29) = ""
strHTMLBody(30) = "</BODY></HTML>"
strHTMLBody(31) = ""
strHTMLBody(32) = ""
strHTMLBody(33) = ""
intEmailCounter = 1

    Sheets("AppliedTo").Activate
' Move to the title column, which is not to contain any breaks.
    Range("C2").Select
' Find the last cell in this column and offset to column Q
    LastRowAddress = Selection.End(xlDown).Offset(0, 14).Address
'  Find the differently highlighted cells in Column Q
    For Each CellObject In Range("Q2:" & LastRowAddress)
        If (CellObject.Interior.ColorIndex = 38) _
            And (intEmailCounter <= 6) _
            And CellObject.Value <= Date Then
            Set objFollowUpEmail(intEmailCounter) = objOL.CreateItem(olMailItem)
            strEmailBody = ""
'  Reset strings 6 and 8 in case the last run was aborted
            strHTMLBody(6) = "<p><b><font size=+1><span style='BACKGROUND-COLOR: #ffcccc'>Dear "
            strHTMLBody(8) = "<p><b>I sent you an email regarding the above invoice on "
            CellObject.Activate
            DateApplied = Int(ActiveCell.Offset(0, -16).Value)
' Move to the second col of this row
            strSalesLine(1) = "Type:  " & ActiveCell.Offset(0, -15).Value
            strSalesLine(2) = "Title:  " & ActiveCell.Offset(0, -14).Value
                objFollowUpEmail(intEmailCounter).Subject = _
                                    ActiveCell.Offset(0, -14).Value
            strSalesLine(3) = "Service Details:  " & ActiveCell.Offset(0, -13).Value
'  Break the length of the Details line to 80 col.
            strSalesLine(4) = "Location:  " & ActiveCell.Offset(0, -12).Value
            strSalesLine(5) = "Start:  " & ActiveCell.Offset(0, -11).Value
            strSalesLine(6) = "Duration:  " & ActiveCell.Offset(0, -10).Value
            strSalesLine(7) = "Pay:  " & ActiveCell.Offset(0, -9).Value
            strSalesLine(8) = "Agency:  " & ActiveCell.Offset(0, -8).Value
            strSalesLine(9) = "Contact:  " & ActiveCell.Offset(0, -7).Value
                strEmailTo = ActiveCell.Offset(0, -7).Value
            strSalesLine(10) = "Tel:  " & ActiveCell.Offset(0, -6).Value
            strSalesLine(11) = "Fax:  " & ActiveCell.Offset(0, -5).Value
            strEmailAddress = ActiveCell.Offset(0, -4).Value
                If Len(strEmailAddress) > 5 Then ' 5= minimum email address length
                    strSalesLine(12) = "Email:  " & strEmailAddress
                    objFollowUpEmail(intEmailCounter).Recipients.Add (strEmailAddress)
                Else
                     MsgReply = MsgBox("Sales at row " _
                        & ActiveCell.Offset(0, -4).Row _
                        & " Does not have an email address" & vbCrLf _
                        & " Will mark and continue", vbOKOnly, "No Email Address")
                    objFollowUpEmail(intEmailCounter).Delete
                     ActiveCell.Interior.ColorIndex = 15
                    GoTo NextCellObject
                End If
            strSalesLine(13) = "Web:  " & ActiveCell.Offset(0, -3).Value
            strSalesLine(14) = "Reference  " & ActiveCell.Offset(0, -2).Value
                objFollowUpEmail(intEmailCounter).Subject = _
                                "Follow-up for: " _
                                & objFollowUpEmail(intEmailCounter).Subject _
                                & " - " & strSalesLine(14)
            strHTMLBody(6) = strHTMLBody(6) & strEmailTo
            strHTMLBody(8) = strHTMLBody(8) & DateApplied
'  Now create the email body
            For intCounter = 1 To 50
                strEmailBody = strEmailBody & strHTMLBody(intCounter)
            Next
            objFollowUpEmail(intEmailCounter).Body = ""
            objFollowUpEmail(intEmailCounter).HTMLBody = ""
            objFollowUpEmail(intEmailCounter).HTMLBody = strEmailBody
            objFollowUpEmail(intEmailCounter).Categories = "MAM750 Sales Search"
            objFollowUpEmail(intEmailCounter).Display
' This line causes an error, therefore use an array variable       objSalesEmail = Nothing
            CellObject.Interior.ColorIndex = 2
            intEmailCounter = intEmailCounter + 1
            
        End If
NextCellObject:
    Next
End Sub


Sub FilterExcel()

'
' FilterExcel Macro
' Macro recorded 21/10/2001 by Dr. Meshkot
'

' Error recovery
On Error GoTo ExitError
    Sheets(strSalesListToday).Activate
    Range("B1").Select
    Selection.AutoFilter Field:=2, Criteria1:="=*Excel *", Operator:=xlAnd
ExitNormal:
    Exit Sub
ExitError:
End Sub


Sub AutoFilterOff()

    ActiveSheet.Range("B1").AutoFilter

End Sub


Sub AdvancedFilterOff()

    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

End Sub



Sub FilterLondonSales()

'
' FilterLondonSales Macro
' Macro recorded 21/10/2001 by Dr. Meshkot
'

'
    Worksheets(strSalesListToday).Range("B1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="=*Service*", Operator:=xlAnd, _
        Criteria2:="<>*cobol*"
    Selection.AutoFilter Field:=4, Criteria1:="=*London*", Operator:=xlAnd
    Selection.AutoFilter Field:=7, Criteria1:="=*3*", Operator:=xlAnd
End Sub


Sub ApplyAdvancedFilter1()

'
' ApplyAdvancedFilter1 Macro
' Macro Created 25/10/2001 by Dr. Meshkot
'
    If SheetExists(strSalesListToday) Then
        Worksheets(strSalesListToday).Activate
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Filter1").UsedRange, Unique:=False
    End If
End Sub


Sub ApplySalesListPrevAdvancedFilter1()

'
' ApplyAdvancedFilter1 Macro
' Macro Created 25/10/2001 by Dr. Meshkot
'
    If SheetExists(strSalesListPrev) Then
        Worksheets(strSalesListPrev).Activate
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Filter1").UsedRange, Unique:=False
    End If
End Sub


Sub ApplyAdvancedFilter2()

'
' ApplyAdvancedFilter1 Macro
' Macro Created 25/10/2001 by Dr. Meshkot
'
    If SheetExists(strSalesListToday) Then
        Worksheets(strSalesListToday).Activate
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Filter2").UsedRange, Unique:=False
    End If
End Sub


Sub ApplyAdvancedFilter3()

'
' ApplyAdvancedFilter1 Macro
' Macro Created 25/10/2001 by Dr. Meshkot
'
    If SheetExists(strSalesListToday) Then
        Worksheets(strSalesListToday).Activate
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        
        ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Filter3").UsedRange, Unique:=False
    End If
End Sub



Sub MarkNewSalesByRef()

' To Mark new Sales from the previous Sales file download
' If there is already a Sales list, then get the previous Sales file to compare with.
Dim LookupResult As Variant
Dim OldSalesReference As Variant
Dim NewSalesReference As Variant
Dim OldSalesFlag As Boolean
Dim LookinTable As Range
Dim SalesReferences As Variant
Dim NewSalesCount As Long
'  Check to see that we have 2 Sales lists imported.
    If SheetExists(strSalesListToday) Then
        If SheetExists(strSalesListPrev) Then
            GoTo Have2Lists
        Else
            ImportSalesFile (strSalesListPrev)
            FormatRawImport (strSalesListPrev)
Have2Lists:
        End If
    Else
        Exit Sub
    End If
'  Name the old Sales list reference column
    Sheets(strSalesListPrev).Activate
    Range("N2").Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
'    Range("N1:" & LastCellInColAddress).Select
    ActiveWorkbook.Names.Add _
        Name:="SalesListOldReference", _
        RefersTo:="=" & ActiveSheet.Name & "!" & "$N$2:" & LastCellInColAddress


'  Name the New (Today's) Sales list reference column
    Sheets(strSalesListToday).Activate
    '  Go to the Sales reference column
        Range("N2").Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
    ActiveWorkbook.Names.Add _
        Name:="SalesListNewReference", _
        RefersTo:="=" & ActiveSheet.Name & "!" & "$N$2:" & LastCellInColAddress
'  Find and highlight the new Sales rows by comparing Today's Saleslist References
'  with the Previous download.
    
'  3 Nov 2001
'  The following method works very well, but takes too long.
'    For Each NewSalesReference In Range(Names("SalesListNewReference"))
'         For Each OldSalesReference In Range(Names("SalesListOldReference"))
'            Application.StatusBar = "Comparing " & NewSalesReference & "  with  " & OldSalesReference
'            If NewSalesReference = OldSalesReference Then OldSalesFlag = True
'         Next OldSalesReference
'         If Not OldSalesFlag Then
'            ' Mark row as being a new Sales
'            NewSalesReference.Select
'            Range(Selection, Cells(ActiveCell.Row, 1)).Select
'            Selection.Interior.ColorIndex = 35
'         End If
'    Next NewSalesReference
    
' NOTE:  There is a problem in the next line which results in runtime error 1004:
' Unable to get the Vlookup property of the Worksheetfunction class.
' This function did not work even with the help file example.
'        LookupResult = Application.VLookup("JS/IMB/ING/3010/01", _
'            Worksheets("SalesListOld").Range("$N$2:$N$6010"), 1, False)

'  3 Nov 2001
'   Another method is to use the VLookup worksheet function on the worksheet
'   and use its results to mark the Sales row if the Sale is a new Sale
'   This method should be faster because the inner loop is eliminated.
'   The method is as follows:
    Application.ScreenUpdating = False
    For Each NewSalesReference In Range(Names("SalesListNewReference"))
        NewSalesReference.Activate
        ' The following IF statement prevents rechecking a cell that is
        '  already marked as a new Sales ref.
        If ActiveCell.Interior.ColorIndex = 35 Then
            NewSalesCount = NewSalesCount + 1
            GoTo NextNewSalesReference
        End If
        ' Move to the next column and insert a VLOOKUP formula
        ActiveCell.Offset(0, 1).Range("A1").Select
        Application.StatusBar = "Processing Row " & ActiveCell.Row
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],SalesListOldReference,1,0)"
        Worksheets(strSalesListToday).Columns("O:O").Calculate
        If Application.WorksheetFunction.IsNA(ActiveCell.Value) Then
        ' Error 2042 means the cell shows "#N/A" which means the Sales reference
        '    is new.  The IsNA function must be used to test for this value.
'            Range(Selection, Cells(ActiveCell.Row, 1)).Select
            Range(Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 3)).Select
            Selection.Interior.ColorIndex = 35
            NewSalesCount = NewSalesCount + 1
            ActiveCell.Offset(0, 12).Range("A1").Select
        End If
        ActiveCell.Clear
NextNewSalesReference:
    Next
    Application.ScreenUpdating = True
    MsgBox "There were " & NewSalesCount & " New Sales in " _
            & ActiveCell.Row & " Rows."

End Sub



Sub MarkNewSalesByDetails()

' To Mark new Sales from the previous Sales file download by comparing Sales Details
Dim LookupResult As Variant
Dim OldSalesDetails As Variant
Dim NewSalesDetails As Variant
Dim OldSalesFlag As Boolean
Dim LookinTable As Range
Dim SalesReferences As Variant
Dim NewSalesCount As Long
'  Check to see that we have 2 Sales lists imported.
    If SheetExists(strSalesListToday) Then
        If SheetExists(strSalesListPrev) Then
            GoTo Have2Lists
        Else
            ImportSalesFile (strSalesListPrev)
            FormatRawImport (strSalesListPrev)
Have2Lists:
        End If
    Else
        Exit Sub
    End If
'  Name the old Sales list reference column
    Sheets(strSalesListPrev).Activate
    Range("C2").Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
'    Range("N1:" & LastCellInColAddress).Select
    ActiveWorkbook.Names.Add _
        Name:="SalesListOldDetails", _
        RefersTo:="=" & ActiveSheet.Name & "!" & "$C$2:" & LastCellInColAddress


'  Name the New (Today's) Sales list reference column
    Sheets(strSalesListToday).Activate
    '  Go to the Sales reference column
        Range("C2").Select
    ' Find the last cell in this column
    LastCellInColAddress = Selection.End(xlDown).Address
    ActiveWorkbook.Names.Add _
        Name:="SalesListNewDetails", _
        RefersTo:="=" & ActiveSheet.Name & "!" & "$C$2:" & LastCellInColAddress
'  Find and highlight the new Sales rows by comparing Today's Saleslist References
'  with the Previous download.
    
'  4 Nov 2001
'  The following method works very well, but takes too long.
'   In this case I have to use the slow method.
    Debug.Print "----------------------------"; Now
    Application.ScreenUpdating = True
    For Each NewSalesDetails In Range(Names("SalesListNewDetails"))
'        On Error Resume Next
         For Each OldSalesDetails In Range(Names("SalesListOldDetails"))
            Application.StatusBar = "Comparing New Sales Row " _
                        & NewSalesDetails.Row & " With Old Sales Row " _
                        & OldSalesDetails.Row
            If Left$(NewSalesDetails, 100) = Left$(OldSalesDetails, 100) Then
                OldSalesFlag = True
                Debug.Print "New Sales Row "; _
                    NewSalesDetails.Row; _
                    " is the same as Old Sales Row "; OldSalesDetails.Row
                    Debug.Print "                       "; NewSalesDetails; " = "; OldSalesDetails
                GoTo MarkNewSales
            Else
                OldSalesFlag = False
            End If
NextOldSalesDetails:
         Next OldSalesDetails
MarkNewSales:
         On Error GoTo 0
         If Not OldSalesFlag Then
            ' Mark row as being a new Sales
            Range(NewSalesDetails.Address).Activate
'            Range(Selection, Cells(ActiveCell.Row, 1)).Select
            ActiveCell.Interior.ColorIndex = 35
            NewSalesCount = NewSalesCount + 1
         End If

    Next NewSalesDetails
    Application.ScreenUpdating = True
    
    MsgBox "There were " & NewSalesCount & " New Sales in " _
            & ActiveCell.Row & " Rows."

End Sub



Sub CleanSaleslistMethod(strSheetName As String)

'   By: M. A. Meshkot
'   19 December 2001 00:50
' This routine is to clean the downloaded and imported Saleslists
' Clean here means removing rows that do not have a valid Sales reference number.
' Valid Sales references begin with SS.
Dim LastCellRow
    If SheetExists(strSheetName) Then
        Sheets(strSheetName).Activate
    Else
        Exit Sub
    End If
    
' Move to the title column, this is taken as the field for which
' all records have a value.
    Range("B2").Select
' Find the last cell in this column
'    LastCellInColAddress = Selection.End(xlDown).Offset(0, 12).address
    LastCellRow = Selection.End(xlDown).Offset(0, 12).Row
' Move to the reference column
    Range("N2").Select
'  Find the missing or invalid Sales references and delete that row.

'  The following method does not work because when a row is deleted
'   the cellobject can not be moved back up by one cell.
'   As a result, if say 2 rows have missing reference numbers,
'   then only the first is deleted.  The second is skipped because after
'   deletion, the cursor is moved to the next CellObject.
'
'    For Each CellObject In Range("N2:" & LastCellInColAddress)
'        If (CStr(CellObject.Value) = "") _
'            Or (Left(CStr(CellObject.Value), 2) <> "SS") Then
'            CellObject.EntireRow.Delete
'        End If
'    Next
'

' This second solution causes an infinite loop when it gets to the last row.
'    While ActiveCell.Row < LastCellRow
'        If (CStr(ActiveCell.Value) = "") _
'            Or (Left(CStr(ActiveCell.Value), 2) <> "JS") Then
'            ActiveCell.EntireRow.Delete
'            ActiveCell.Offset(-1, 0).Activate
'        End If
'        ActiveCell.Offset(1, 0).Activate
'    Wend
    
'   Solution 3: Reduce the last row number whenever a row is deleted.
    Application.ScreenUpdating = False
    While ActiveCell.Row < LastCellRow
        If (CStr(ActiveCell.Value) = "") _
            Or (Left(CStr(ActiveCell.Value), 2) <> "JS") Then
            ActiveCell.EntireRow.Delete
            LastCellRow = LastCellRow - 1
            ActiveCell.Offset(-1, 0).Activate
        End If
        ActiveCell.Offset(1, 0).Activate
    Wend
    Application.ScreenUpdating = True
    Range("N2").Select
End Sub

Sub CleanSalesList()
    CleanSaleslistMethod (strSalesListToday)
End Sub

 

Please click on the link below to return to the English Home Page

If you require some further information, Please Contact Me

Return to English Home Page

Return to Work Samples

Copyright © 2001 Dr. M. A. Meshkot
This page was last updated May 2004