''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'        © Copyright 2011-2013 University of Manitoba 
'
' This program is free software: you can redistribute it and/or modify it 
' under the terms of the GNU General Public License as published by the Free 
' Software Foundation, either version 3 of the License, or (at your option) 
' any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Description: This Excel VBA code has been developed as an automated process
'             to generate DQ tables and Chart without manual intervention

'Author: Say Pham Hong

'Please direct questions and comments to info@cpe.umanitoba.ca

'Nov. 27, 2012

'Updated Mar. 27, 2015

'
'
'

sub adjrowhght(find as string)
  dim cell As Range
  set Rng = Range("A1:M" & cells(rows.count,1).End(xlup).Row)
  for each cell in rng
    If (cell.Value = find) then 
      count = count + 1
      rw = cell.row
    End If
  next
  If find = "Codenum" Then
    If count = 2 Then 
      For r = rw-1 to rw
        Rows(r).RowHeight = 26
      Next
    ElseIf count = 3 Then
      For r = rw-2 to rw
        Rows(r).RowHeight = 18
      Next
    End If 
  ElseIf find = "Datetime" Then
    If count = 2 Then
      For r = rw-1 to rw
        Rows(r).RowHeight = 27
      Next
    ElseIf count = 3 Then
      For r = rw-2 to rw
        Rows(r).RowHeight = 18
      Next
    ElseIf count = 4 Then
      For r = rw-3 to rw
        Rows(r).RowHeight = 15
      Next
    End If
  ElseIf find = "Time" Then
    If count = 2 Then
      For r = rw-1 to rw
        Rows(r).RowHeight = 17
      Next
    End If
  End If
end sub

Function cntWords(Cell As Range) As Variant
  If Len(Trim(Cell.Text)) > 0 Then
  With Application.WorksheetFunction
    cntWords = Len(.Trim(Cell.Text)) - Len(.Substitute(.Trim(Cell), " ", "")) + 1
  End With
  Else
    cntWords = 0
  End If
End Function


'Merge Cells with Same Values

sub merg()
  
  Dim n as Integer
  lcol = Cells(1, Columns.Count).End(xlToLeft).Column	' Count number of Column
  cntrow = cells(rows.count,1).End(xlup).Row
  Range("A2:A"&cntrow).Orientation = 90
  Range("A2:A"&cntrow).HorizontalAlignment = xlCenter
  Range("A2:A"&cntrow).Font.Bold = True			' make first column bold face
  Range(Cells(1,1), Cells(1,lcol)).Font.Bold = True	' make first row bold face
  Range(Cells(1,1), Cells(1,lcol)).HorizontalAlignment = xlCenter


  call adjrowhght("Codenum")
  call adjrowhght("Datetime")
  call adjrowhght("Time")

  
' Format cells value to 2 decimal places

  For r = 1 to cells(rows.count,1).End(xlup).Row
    If cells(r, 1).Value = "Num" Then
	  Range(cells(r,4),cells(r,12)).NumberFormat = "#.00"
	Else
	  Range(cells(4,4),cells(r,7)).NumberFormat = "#.00"
	End If
  Next r

  For r = 1 to cells(rows.count,1).End(xlup).Row

'    if cells(r + 1, 1).Value = "Codenum" and cells(r, 1) <> cells(r + 1, 1) Then
'      os = r
'    End if
      
    if cells(r, 1).Value = "Char" or cells(r, 1).value="Codenum" Then
      Range(Cells(r, 8), Cells(r, 12)).MergeCells = True
    End if
    if cells(r, 1) = cells(r + 1, 1) Then
      n = n + 1
    End if
    If cells(r,1) <> cells(r + 1, 1) And n > 0 Then
      Range(cells(r - n, 1), cells(r, 1)).MergeCells = True
      Range(cells(r - n, 1), cells(r, 1)).VerticalAlignment = xlCenter
      n = 0
    End if
  Next r

  For r = 1 to cells(rows.count,1).End(xlup).Row
    if cells(r + 1, 1).Value = "Codenum" and cells(r, 1) <> cells(r + 1, 1) Then
      os = r
      exit for
    elseif cells(r + 1, 1).Value = "Char" and cells(r, 1) <> cells(r + 1, 1) Then
      os = r
      exit for
    End if
  next

  Range("A1").Activate
  If Not IsEmpty(os) Then
    ActiveCell.Offset(os).EntireRow.Insert
    Range("A" & os & ":" & "M" & os).Borders(xlEdgeBottom).LineStyle = xlContinuous	'add this line to add borders at top of observe data
    Cells(os + 1, 8).Value = "Top 10 Observed Values"
    Cells(os + 1, 8).Font.Bold = True
    Range("A" & os + 1 & ":M" & os + 1).Interior.Color = RGB(255, 255, 255)
    Range(Cells(os + 1, 8), Cells(os + 1, 12)).MergeCells = True
    Range(Cells(os + 1, 8), Cells(os + 1, 12)).HorizontalAlignment = xlCenter
  End If

End sub


' Conditioning Formatting 

sub ChangeFontColor()
  Dim Cell As Range
  Dim Rng1 AS Range
 
  set Rng1 = Range("D2:D"&cells(rows.count,1).End(xlup).Row+1)

  For each cell In Rng1
    Select case cell.value
    case vbNullString
      cell.Interior.ColorIndex = xlNone
      cell.Font.Bold = False
    case Is < 70
      cell.Interior.Color = RGB(242, 220, 219)
      cell.Font.ColorIndex = 3
      cell.Font.Bold = True
    case Is < = 95
      cell.Interior.ColorIndex = 40
      cell.Font.ColorIndex = 46
      cell.Font.Bold = True
    case Is < = 100
      cell.Interior.ColorIndex = 35
      cell.Font.ColorIndex = 50
      cell.Font.Bold = True
    case Else
      cell.Interior.ColorIndex = xlNone
      cell.Font.Bold = False
    End Select
  Next

End sub


'Draw Borderline

Public Sub border()
  Dim myBorders() As Variant, item As Variant
  myBorders = Array(xlEdgeLeft, _
                    xlEdgeTop, _
                    xlEdgeBottom, _
                    xlEdgeRight, _
                    xlInsideVertical)
  ActiveSheet.Range("A1:M" & Cells(Rows.Count, 1).End(xlup).Row).select	'Select Range of Cells
  For Each item In myBorders
    With Selection.Borders(item)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
  Next item
  Selection(1, 1).Select	'Deselect Range of Cells
End Sub


'Generate Graph

sub AddChart

  Dim RngCover As Range
  Dim ChartObj As ChartObject
  Dim foundchar As Boolean
  Dim Sh As String
  Sh = ActiveSheet.Name

  foundchar = False
  lastrow = cells(rows.count,2).End(xlup).Row
  For r = 1 to lastrow
    If cells(r + 1, 1).Value = "Codenum" and IsEmpty(cells(r, 1)) Then
      n = r
      foundchar = True
      Exit For
    ElseIf cells(r + 1, 1).Value = "Char" and IsEmpty(cells(r, 1)) Then
      n = r
      foundchar = True
      Exit For
    End if
  Next r

  Charts.add
  With ActiveChart
    .ChartType = xlbarstacked100
    .HasLegend = True
    .Legend.Position = xlbottom
    .HasTitle = True
    .ChartTitle.Characters.Text = "Vimo Graph"
    .Axes(xlValue).MINImumScale = 0
    .Axes(xlValue).MaximumScale = 1

    .Axes(xlCategory).TickLabels.AutoScaleFont = False 

    With .Axes(xlCategory).TickLabels.Font  
      .Name = "Arial" 
      .FontStyle = "Regular" 
      .Size = 8  
    End With 

    .Axes(xlCategory).MajorTickMark = xlTickMarkNone
    .Axes(xlCategory).ReversePlotOrder = True
    .Axes(xlValue).TickLabelPosition = xlTickLabelPositionHigh
	
	.PlotBy = xlcolumns
    
    .ChartGroups(1).GapWidth = 75

    If foundchar = True Then

    .SetSourceData Source:=Application.Union(Range(Sh &"!A1:B" & n-1), Range(Sh &"!A" & n+1 & ":B" & lastrow), _
                                             Range(Sh &"!D1:G" & n-1), Range(Sh &"!D" & n+1 & ":G" & lastrow))
    Else
      .SetSourceData Source:=Application.Union(Range(Sh &"!A1:B" & lastrow), Range(Sh &"!D1:G" & lastrow))
    End If
	
    .SeriesCollection(1).Interior.Color = RGB(79, 129, 189)
    .SeriesCollection(2).Interior.Color = RGB(192, 80, 77)
    .SeriesCollection(3).Interior.Color = RGB(155, 187, 89)
    .SeriesCollection(4).Interior.Color = RGB(128, 100, 162)

    .Location where:=xllocationasobject, name:=sh
  End With

  Set RngCover = ActiveSheet.Range("O1:X" & lastrow + 6)
  Set ChartObj = ActiveChart.Parent
  ChartObj.Height = RngCover.Height
  ChartObj.Width = RngCover.Width
  ChartObj.Top = RngCover.Top
  ChartObj.Left = RngCover.Left

End sub

Sub sublegend()

Dim foundsup, foundstar, found2star, allmiss, novariant, validminmax As Boolean
'foundsup = False
'foundstar = False
'found2star = False
For currentrow = 1 To cells(rows.count,"B").End(xlup).Row
  celltext = cells(currentrow, 8).value
  If celltext = "SUPPRESSED" Then foundsup = True
  cellchar = cells(currentrow, 2).value
  'If InStr(cellchar, "*") <> 0 Then foundstar = True
  'If Instr(cellchar, "**") <> 0 Then found2star = True
  If replace(right(cellchar, 2), " ", "") = "*" Then foundstar = True
  If right(cellchar, 2) = "**" Then found2star = True
  If cells(currentrow, 6).value = 100 then allmiss = True
  'If cells(currentrow, 8).value = cells(currentrow, 9).value and cells(currentrow, 6) <> 100 and Not IsEmpty(Cells(currentrow, 8)) Then novariant = True
  If cells(currentrow, 8).value = cells(currentrow, 9).value and cells(currentrow, 6) = 0 and Not IsEmpty(Cells(currentrow, 8)) Then novariant = True



  If Not IsError(Application.Match(cells(currentrow, 1).Value, Array("Codenum", "Char"), False)) Then

    Dim rng As Range
    Dim rngStart As Range
    Dim rngEnd As Range

    Set rng = Range("A"&currentrow)

    If rng.MergeCells Then
      Set rng = rng.MergeArea
      Set rngStart = rng.Cells(1, 1)
      Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)
      For i = Range(rngStart.Address).Row to Range(rngEnd.Address).Row
        cntwrd = cntWords(cells(i, 8))
        If cntwrd = 1 and cells(i, 6) = 0 Then novariant = True
      Next
    End If

  End If

  If right(cells(currentrow, 8).value, 1) = "*" Then 
    validminmax = True
  '  Range("I"&currentrow).NumberFormat = "General"
    Range("H"&currentrow).NumberFormat = "@"		'convert cell to text so that it will be auto-format it
    Range("H"&currentrow).value = Mid(Range("H"&currentrow).value, 1, InStr(Range("H"&currentrow).value, "*")-1)
  End If
'  If IsError(Application.Match(cells(currentrow, 1).Value, Array("Codenum", "Char"), False)) Then Range("I"&currentrow) = replace(Range("I"&currentrow).value, "*", "")
  'If foundsup = True and foundstar = True and found2star = True and allmiss = True and novariant = True and validminmax = True Then exit For
Next


If validminmax = True Then

  If foundsup = True Then 	''**4**
    If foundstar = True Then 	''**3**
      If found2star = True Then 	''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:8").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          Range("B5").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 15
          Range("A6").Interior.ColorIndex = RGB(218, 218, 218)
          Range("B6").Value = " = No variance or 100% missing value"
          Range("B6").Font.Bold=True
          'Range("A7").Interior.ColorIndex = 20
          Range("A7").Interior.Color = RGB(220, 230, 239)
          Range("B7").Value = " = Min, Max values based on valid range"
          Range("B7").Font.Bold=True
          Range("A10", "M10").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then 	'**1**
          Rows("1:7").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          Range("B5").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 20
          Range("A6").Interior.Color = RGB(220, 230, 239)
          Range("B6").Value = " = Min, Max values based on valid range"
          Range("B6").Font.Bold=True
          Range("A9", "M9").select
          ActiveWindow.FreezePanes = True
        End If 	''**1**
      Else	''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:7").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 20
          Range("A6").Interior.Color = RGB(220, 230, 239)
          Range("B6").Value = " = Min, Max values based on valid range"
          Range("B6").Font.Bold=True
          Range("A9", "M9").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True
        End If		''**1** 
      End If	''**2**
    Else		''**3**
      If found2star = True Then		''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:7").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 20
          Range("A6").Interior.Color = RGB(220, 230, 239)
          Range("B6").Value = " = Min, Max values based on valid range"
          Range("B6").Font.Bold=True
          Range("A9", "M9").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True
        End If		''**1**
      Else		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 20
          Range("A4").Interior.Color = RGB(220, 230, 239)
          Range("B4").Value = " = Min, Max values based on valid range"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If 		''**1**
      End If		''**2**
    End If		''**3**
  Else			''**4**
    If foundstar = True Then		''**3**
      If found2star = True Then		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:7").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 20
          Range("A6").Interior.Color = RGB(220, 230, 239)
          Range("B6").Value = " = Min, Max values based on valid range"
          Range("B6").Font.Bold=True
          Range("A9", "M9").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True
        End If		''**1**
      Else		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 20
          Range("A4").Interior.Color = RGB(220, 230, 239)
          Range("B4").Value = " = Min, Max values based on valid range"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If 					''**1**
      End If		''**2**
    Else			''**3**
      If found2star = True Then 		''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 20
          Range("A5").Interior.Color = RGB(220, 230, 239)
          Range("B5").Value = " = Min, Max values based on valid range"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 20
          Range("A4").Interior.Color = RGB(220, 230, 239)
          Range("B4").Value = " = Min, Max values based on valid range"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If				''**1**
      Else				''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:5").Insert
          'Range("A3").RowHeight = 25
          'Range("A3").Interior.ColorIndex = 15
          Range("A3").Interior.Color = RGB(218, 218, 218)
          Range("B3").Value = " = No variance or 100% missing value"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 20
          Range("A4").Interior.Color = RGB(220, 230, 239)
          Range("B4").Value = " = Min, Max values based on valid range"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:4").Insert
          'Range("A3").Interior.ColorIndex = 20
          Range("A3").Interior.Color = RGB(220, 230, 239)
          Range("B3").Value = " = Min, Max values based on valid range"
          Range("B3").Font.Bold=True
          Range("A6", "M6").select
          ActiveWindow.FreezePanes = True
        End If					''**1**
      End If					''**2**
    End If					''**3**
  End If						''**4**

Else

  If foundsup = True Then 	''**4**
    If foundstar = True Then 	''**3**
      If found2star = True Then 	''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:7").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          Range("B5").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B5").Font.Bold=True
          'Range("A6").Interior.ColorIndex = 15
          Range("A6").Interior.Color = RGB(218, 218, 218)
          Range("B6").Value = " = No variance or 100% missing value"
          Range("B6").Font.Bold=True
          Range("A9", "M9").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then 	'**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          Range("B5").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True
        End If 	''**1**
      Else	''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If		''**1** 
      End If	''**2**
    Else		''**3**
      If found2star = True Then		''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If		''**1**
      Else		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:4").Insert
          Range("A3").RowHeight = 20
          Range("B3").Value = "SUPPRESSED = Variables being suppressed in data file"
          Range("B3").Font.Bold=True
          Range("A6", "M6").select
          ActiveWindow.FreezePanes = True
        End If 		''**1**
      End If		''**2**
    End If		''**3**
  Else			''**4**
    If foundstar = True Then		''**3**
      If found2star = True Then		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:6").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          'Range("A5").Interior.ColorIndex = 15
          Range("A5").Interior.Color = RGB(218, 218, 218)
          Range("B5").Value = " = No variance or 100% missing value"
          Range("B5").Font.Bold=True
          Range("A8", "M8").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          Range("B4").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True
        End If		''**1**
      Else		''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:4").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "* = All postal codes listed here have frequency count > 20"
          Range("B3").Font.Bold=True
          Range("A5", "M5").select
          ActiveWindow.FreezePanes = True
        End If 					''**1**
      End If		''**2**
    Else			''**3**
      If found2star = True Then 		''**2**
        If allmiss = True or novariant = True Then 	''**1**
          Rows("1:5").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B3").Font.Bold=True
          'Range("A4").Interior.ColorIndex = 15
          Range("A4").Interior.Color = RGB(218, 218, 218)
          Range("B4").Value = " = No variance or 100% missing value"
          Range("B4").Font.Bold=True
          Range("A7", "M7").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:4").Insert
          Range("A3").RowHeight = 25
          Range("B3").Value = "** = Postal codes suppressed due to small frequency count"
          Range("B3").Font.Bold=True
          Range("A6", "M6").select
          ActiveWindow.FreezePanes = True
        End If				''**1**
      Else				''**2**
        If allmiss = True or novariant = True Then	''**1**
          Rows("1:4").Insert
          'Range("A3").RowHeight = 25
          'Range("A3").Interior.ColorIndex = 15
          Range("A3").Interior.Color = RGB(218, 218, 218)
          Range("B3").Value = " = No variance or 100% missing value"
          Range("B3").Font.Bold=True
          Range("A6", "M6").select
          ActiveWindow.FreezePanes = True	
        ElseIf allmiss = False and novariant = False Then		''**1**
          Rows("1:3").Insert
          Range("A5", "M5").select
          ActiveWindow.FreezePanes = True
        End If					''**1**
      End If					''**2**
    End If					''**3**
  End If						''**4**

End If

End sub


sub gen_report

  For r = 1 to cells(rows.count,1).End(xlup).Row
    if cells(r, 1).Value <> "Char" and cells(r, 1).value <> "Codenum" Then
      Range(Cells(r, 8), Cells(r, 9)).HorizontalAlignment = xlCenter
    end if
	
	If Range("M"&r).value = "Y" Then		'add check mark for those variable that have format and no invalid values were found
	  Range("M"&r).value = chrW(&H2713)		'March 20, 2015
	End if

    If Len(Range("M"&r).value) > 60 Then 
      pos = InStr(Range("M"&r).value, "[")
      If pos <> 0 Then
        Range("M"&r).value = Mid(Range("M"&r).value, 1, pos-1) & Chr$(10) & Mid(Range("M"&r).value, pos)
      Else
        Range("M"&r).WrapText = True
      End If
    End If
    If right(cells(r, 8).value, 1) = "*" Then   'flag valid min max value for date and datetime
    '  Range("H"&r).Interior.ColorIndex = 20
    '  Range("I"&r).Interior.ColorIndex = 20
      Range("H"&r).Interior.Color = RGB(220, 230, 239)
      Range("I"&r).Interior.Color = RGB(220, 230, 239)
      'Range("H"&r).value = replace(Range("H"&r).value, "*", "")
      'Range("H"&r) = replace(Range("H"&r).value, "*", "")
    End If
  next

  Columns("M:M").HorizontalAlignment = xlcenter 
  Range("M:M").ColumnWidth = 50
  'Range("M:M").HorizontalAlignment = xlHAlignRight

  Dim Sh As String
  Sh = ActiveSheet.Name

'Generate bottom Line
  For r = 1 to cells(rows.count,1).End(xlup).Row
    If cells(r, 1) <> cells(r + 1, 1) Then
      Range("A" & r + 1 & ":" & "M" & r + 1).Borders(xlEdgeTop).LineStyle = xlContinuous
    End if
  Next r

  Range("A1:M1").Interior.Color = RGB(238, 236, 225)
  Range("A1:A" & cells(rows.count,1).End(xlup).Row).Interior.Color = RGB(238, 236, 225)


  For r = 1 to cells(rows.count,1).End(xlup).Row
'    If Not IsError(Application.Match(cells(r, 1).Value, Array("Num", "Codenum", "ID", "Date", "Datetime", "Time"), False)) Then
      If cells(r, 6).value = 100 Then
'        Range("H"&r).value = replace(Range("H"&r).value, ".", "")
'        Range("I"&r).value = replace(Range("I"&r).value, ".", "")
        cells(r, 8).value = " "
        cells(r, 9).value = " "
        'range(cells(r, 8), cells(r, 12)).Interior.ColorIndex = 15   ' Assign grey color to 100% missing variables
        range(cells(r, 8), cells(r, 12)).Interior.Color = RGB(218, 218, 218)
      End If
'    End If
  Next r

'*** Assign grey color to non-variant character variables

  For r = 1 to cells(rows.count,1).End(xlup).Row
    If Not IsError(Application.Match(cells(r, 1).Value, Array("Codenum", "Char"), False)) Then
      nwords = cntwords(cells(r,8))
      If nwords = 1 and cells(r,8).value <> "SUPPRESSED" and cells(r, 6) = 0 Then
      '  range(cells(r, 8), cells(r, 12)).Interior.ColorIndex = 15
        range(cells(r, 8), cells(r, 12)).Interior.Color = RGB(218, 218, 218)
      End If
    End If
    If Not IsError(Application.Match(cells(r, 1).Value, Array("Num", "Date", "Datetime", "Time"), False)) Then
      'If cells(r, 8).value = cells(r, 9).value and cells(r, 6).value = 0 and Not IsEmpty(Cells(r, 6)) Then
      If cells(r, 8).value = cells(r, 9).value and cells(r, 6).value = 0 and Not IsEmpty(Cells(r, 6)) Then
      '  range(cells(r, 8), cells(r, 12)).Interior.ColorIndex = 15
        range(cells(r, 8), cells(r, 12)).Interior.Color = RGB(218, 218, 218)
      End If
    End If
  Next r
'***


  call ChangeFontColor		'If no date variable in the output this must run before merg
  call merg
  call AddChart
  Columns("A:G").EntireColumn.AutoFit
  call border
  call sublegend


  For currentrow = 1 To cells(rows.count,1).End(xlup).Row
    celltext = Sheets(sh).Cells(currentrow, 8).Value
    If celltext = "SUPPRESSED" Then
      Cells(currentrow, 2).Font.Bold = True
      Cells(currentrow, 3).Font.Bold = True
      Cells(currentrow, 8).Font.Bold = True
    End If
  Next  

  Range("H1").Value = "Legend (Potential Data Quality Problems) :"
  Range("H1").Font.Bold=True
  Range(Cells(1, 8), Cells(1, 11)).MergeCells = True
  Range("H2").Value = "None or Minimal" & CHR$(10) & "< 5%"
'  Range("H2").Value = "None or Minimal < 5%"
  If Len(Range("H2").Value) > 15 Then
    Range("H2").WrapText = True
    Range("H2").ColumnWidth = 16
  End If
  Range("H2").HorizontalAlignment = XlCenter
  Range("H2").Interior.ColorIndex = 35
  Range("H2").Font.ColorIndex = 50
  Range("H2").Font.Bold = True
  Range("I2").Value = "Moderate" & CHR$(10) & "5-30%"
'  Range("I2").Value = "Moderate 5-30%"
  If Len(Range("I2").value) > 8 Then
    Range("I2").WrapText = True
    Range("I2").ColumnWidth = 9
  End If
  Range("I2").Interior.ColorIndex = 40
  Range("I2").Font.ColorIndex = 46
  Range("I2").Font.Bold = True
  Range("I2").WrapText = True
  Range("I2").HorizontalAlignment = XlCenter
  Range("I2").columnwidth = 18
  Range("J2").Value = "Significant" & Chr$(10) & "> 30%"
'  Range("J2").Value = "Significant > 30%"
  If Len(Range("J2").Value) > 11 Then
    Range("J2").WrapText = True
    Columns(10).ColumnWidth = 12
  End If
  Range("J2").HorizontalAlignment = XlCenter
  Range("J2").Interior.Color = RGB(242, 220, 219)
  Range("J2").Font.ColorIndex = 3
  Range("J2").Font.Bold = True
  Range("K2").Value =  "Unknown" & Chr$(10) & "or N/A"
'  Range("K2").Value =  "Unknown or N/A"
  If Len(Range("K2").Value) > 8 Then
    Range("K2").WrapText = True
    Columns(11).ColumnWidth = 9
  End If
  Range("K2").HorizontalAlignment = XlCenter
  Range("K2").Font.Bold = True

  Activesheet.Range("H2:K2").Select
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
	
  nrow = cells(rows.count,2).End(xlup).Row

  ActiveSheet.Range("A1:M"&nrow).select
  with selection.Font
    .Name = "Arial"
  '  .Size = 40
  '  .Italic = True
  '  .Underline = xlUnderlineStyleNone
  '  .ThemeColor = xlThemeColorLight1
  '  .ThemeFont = xlThemeFontMinor
  End With

  Columns("H:M").EntireColumn.AutoFit
  
'Add legend for comment column		March 27, 2015

  For r = 1 to cells(rows.count,13).End(xlup).Row
    if Range("M"&r).Value = chrW(&H2713) Then
      test = "Y"
      exit for
	end if
  next
  
'  For r = 1 to cells(rows.count,13).End(xlup).Row
'    if Range("M"&r).Value <> chrW(&H2713) and Range("M"&r).Value <> "Comment" and Not IsEmpty(Range("M"&r)) Then
'      invalid = "Y"
'      exit for
'	end if
'  next

  If IsEmpty(Range("H4")) Then 
    Range("H4").Value = "Legend for comment column"
	Range("H4").Font.Bold = True
  Else
    Rows("4").Insert
	Range("H4").value = "Legend for comment column"
  End If 
  Range("H4").Font.Bold = True
  If IsEmpty(Range("H5")) Then 
    Range("H5").Value = "Blank = variables have not been tested (no formats have been specified for the variables)"
  Else
    Rows("5").Insert
	Range("H5").Value = "Blank = variables have not been tested (no formats have been specified for the variables)"
  End If
  Range("H5").Font.Bold = True
  If test = "Y" Then
    If IsEmpty(Range("H6")) Then 
      Range("H6").Value = chrW(&H2713) & " = Variables have been tested against the associated formats and no invalid values found"
    Else
      Rows("6").Insert
	  Range("H6").Value = chrW(&H2713) & " = Variables have been tested against the associated formats and no invalid values found"
    End If
	Range("H6").Font.Bold = True
	If Not IsEmpty(Range("H7")) Then Rows("7").Insert
'	If invalid = "Y" Then
'	  Range("H7").Value = "All or partial list of invalid codes with total number of invalid observations in the dataset"
'	  Range("H7").Font.Bold = True
'	  If Not IsEmpty(Range("H8")) Then Rows("8").Insert
'	End If
  Else
    If Not IsEmpty(Range("H6")) Then Rows("6").Insert
'	If invalid = "Y" Then
'	  Range("H6").Value = "All or partial list of invalid codes with total number of invalid observations in the dataset"
'	  Range("H6").Font.Bold = True
'	  If Not IsEmpty(Range("H7")) then Rows("7").Insert
'	End If
  End If
  
'End add legend for comment column


'  Range("A5", "M5").select
'  ActiveWindow.FreezePanes = True	'Freeze the first 4 rows

  Selection(1, 1).Select

End sub


Public sub other()
  ncol = Cells(1, Columns.Count).End(xlToLeft).Column		'Count number of column
  nrow = Cells(Rows.Count, 1).End(xlup).Row					'Count number of row
  Range(Cells(1,1), Cells(1,ncol)).Font.Bold = True
  Range(Cells(1,1), Cells(nrow,ncol)).VerticalAlignment = xlCenter
  Range(Cells(1,1), Cells(1,ncol)).HorizontalAlignment = xlCenter
  
  For i = 1 to nrow
    If (i mod 2) = 0 Then
      Range(Cells(i, 1), Cells(i, ncol)).Interior.Color = RGB(230, 230, 230)
    End If
  Next i
  
  For i = 1 to nrow
    For j = 1 to ncol
	  IF IsNumeric(Cells(i,j)) = True Then
	    Cells(i,j).HorizontalAlignment = XlCenter
'            cells(i,j).NumberFormat = "#.00"
	  End IF
	Next j
  Next i


  set rng = Range(Cells(1, 1), Cells(1, ncol))
  For each targetcell in rng.cells
    If Len(targetcell.value) > 20 then
      targetcell.ColumnWidth = 20
      targetcell.WrapText = True
      targetcell.EntireRow.AutoFit
    Else
      targetcell.RowHeight = 25
    End If
  Next targetcell

'  Rows(1).EntireRow.AutoFit

  Dim myBorders() As Variant, item As Variant
  myBorders = Array(xlEdgeLeft, _
                    xlEdgeTop, _
                    xlEdgeBottom, _
                    xlEdgeRight, _
                    xlInsideVertical)
  ActiveSheet.Range(Cells(1,1), Cells(nrow, ncol)).select	'Select Range of Cells
  For Each item In myBorders
    With Selection.Borders(item)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
  Next item
  
  Activesheet.Range(Cells(1,1), Cells(1, ncol)).select
    with Selection.Borders
	  .LineStyle = Xlcontinuous
	  .Weight = XlThin
	  .ColorIndex = XlAutomatic
	End with
	
  For i = 1 to ncol
    'Columns(i).ColumnWidth=30
	Columns(i).Autofit
  Next i

  Range("A2:A"&nrow).RowHeight = 25
  Selection(1, 1).Select	'Deselect Range of Cells
  
End Sub


sub AddLineChart()

  Dim RngCover As Range
  Dim ChartObj As ChartObject

  lastrow = cells(rows.count,2).End(xlup).Row
  lcol = Cells(1, Columns.Count).End(xlToLeft).Column

   iAlpha = Int(lcol / 27)
   iRemainder = lcol - (iAlpha * 26)

   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If


  Set rng = Range(cells(2,2), cells(lastrow,lcol))
  minimum = Application.WorksheetFunction.Min(rng)
'  MsgBox converttoletter


  Charts.add
  With ActiveChart
    .ChartType = xlLineMarkers
    .HasLegend = True
 '   .Legend.Position = xlbottom
    .HasTitle = True
    .ChartTitle.Characters.Text = "Percentage of Linkable Records"
    .Axes(xlValue).MINImumScale = Int(minimum)-10
    .Axes(xlValue).MaximumScale = 100
 '   .DisplayUnit = xlNone


    .Axes(xlCategory).TickLabels.AutoScaleFont = False 

    With .Axes(xlCategory).TickLabels.Font  
      .Name = "Arial" 
      .FontStyle = "Regular" 
      .Size = 8  
    End With 

    .Axes(xlCategory).MajorTickMark = xlOutside
    .Axes(xlValue).MajorTickMark = xlTickMarkNone
    .Axes(xlValue).TickLabels.NumberFormat = "0"	'Changing decimal of y-axis of a chart to 0
    .Axes(xlCategory).ReversePlotOrder = False
'    .Axes(xlValue).TickLabelPosition = xlTickLabelPositionHigh
	
    .PlotBy = xlcolumns


    ActiveChart.SetSourceData Source:=Range("linkability_over_years!A1:"& converttoletter & lastrow)
    .Location where:=xllocationasobject, name:="linkability_over_years"
  End With


  Set RngCover = ActiveSheet.Range(cells(5,lcol+2), cells(15, lcol+15))
  Set ChartObj = ActiveChart.Parent
  ChartObj.Height = RngCover.Height
  ChartObj.Width = RngCover.Width
  ChartObj.Top = RngCover.Top
  ChartObj.Left = RngCover.Left

End sub