Summary Report Automation by vba Sourav Bhattacharya

Sub firstone()
     Application.DisplayAlerts = False
    
     On Error Resume Next
ActiveWorkbook.Sheets("Sheet1").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet1"
'heading


    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "State"

    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Unit Head"
        Columns("B:B").EntireColumn.AutoFit
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Total No. Of Dealers"
  
    Columns("C:C").EntireColumn.AutoFit
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "No. Of Dealers Billed Dsp This Month"
  
    Columns("D:D").EntireColumn.AutoFit
  
  
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "No. of Dealers Not Billed DSP This Month(A)"
   
    Columns("E:E").EntireColumn.AutoFit
    Range("F1").Select
    ActiveCell.FormulaR1C1 = _
        "No. of Dealer who build DSP Last month but not this month(B)"
 
    Columns("F:F").EntireColumn.AutoFit
    Range("G1").Select
  

    ActiveCell.FormulaR1C1 = _
        "No. of Dealer whose Trade Volume is higher than State Avg but DSP contribution % is less than Stae Avg(C)"
   
    Columns("G:G").EntireColumn.AutoFit
   
    'heading end
   

     Dim source As Range
     Dim nCol As Integer
     Dim nRow As Integer
     Dim tempstr As String
     Dim str As String
    
      Sheets("Sheet1").Select
    Range("A2:XFD104856").Select
 
 
    Selection.Clear
   
     Dim k As Integer
    
On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data"
 ActiveWorkbook.Sheets("Total No. of Dlrs").Select
    
    Range("A1").Select
    On Error Resume Next
   
    ActiveSheet.ShowAllData
     Range("A1").Select
      
   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter
   End If
  

Dim temppos As String
temppos = "B2"

 Sheets("Total No. of Dlrs").Select
  
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("temp_data").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$3473").RemoveDuplicates Columns:=1, Header:=xlNo
   
    Dim i As Integer
Dim j As Integer
Dim pos As String
Dim filterrange As String

'
    Sheets("temp_data").Select
    Range("A1").Select
   
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
j = (Selection.Rows.Count) - 1
   
    Range("A1").Select
  
    For i = 1 To j
   
    pos = ActiveCell.Offset(i, 0).Address
    Range(pos).Select
   
    Selection.Copy
     Range("B2").Select
    ActiveSheet.Paste
   ActiveWorkbook.Sheets("Total No. of Dlrs").Select
   On Error Resume Next
    ActiveSheet.ShowAllData
   
    Range("A1").Select
      
   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter
  
   End If
  
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    filterrange = Selection.Address
       Range(filterrange).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("temp_data").Range("B1:B2"), Unique:=False
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
  
    Selection.Copy
   
    ActiveWorkbook.Sheets("Sheet1").Select
    Range(temppos).Select
   
    ActiveSheet.Paste
    Range(temppos).Select
    Range(Selection, Selection.End(xlDown)).Select
   Selection.RemoveDuplicates Columns:=1, Header:=xlNo
       Range(temppos).Select
       Range(Selection, Selection.End(xlDown)).Select
       For k = 1 To Selection.Rows.Count
       If ActiveCell.Value = "NA" Then
      
      
       ActiveCell.EntireRow.Delete
       Else
       ActiveCell.Offset(1, 0).Select
      
      
           End If
      
      
      
      
      
       Next k
      
        Sheets("temp_data").Select
    Range("B2").Select
     Selection.Copy
  
       
        Sheets("Sheet1").Select
         Range(temppos).Select
         ActiveCell.Offset(0, -1).Select
         ActiveSheet.Paste
         str = ActiveCell.Value
        
          Range(temppos).Select
           Selection.End(xlDown).Select
           ActiveCell.Offset(0, -1).Select
           ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = "Total " & str
           
           ActiveCell.Resize(1, 2).Select
    

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
   
         
           ActiveCell.Offset(-1, 0).Select
          
           While ActiveCell.Value = ""
           ActiveCell.Value = str
          
           ActiveCell.Offset(-1, 0).Select
          
          
          
           Wend
           'test
            Range(temppos).Select
             ActiveCell.Offset(0, 1).Select
           While ActiveCell.Offset(0, -1).Value <> ""
          
           ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('Total No. of Dlrs'!C[-2],Sheet1!RC[-2],'Total No. of Dlrs'!C[3],Sheet1!RC[-1])"
  
          
           ActiveCell.Offset(1, 0).Select
          
          
           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 2).Select
             While ActiveCell.Offset(0, -2).Value <> ""
            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No. of dlrs billed in CM'!C[-3],Sheet1!RC[-3],'No. of dlrs billed in CM'!C[2],Sheet1!RC[-2])"
           ActiveCell.Offset(1, 0).Select
          
          
           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 3).Select
             While ActiveCell.Offset(0, -3).Value <> ""
            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No. of dlrs not billed in CM'!C[-4],Sheet1!RC[-4],'No. of dlrs not billed in CM'!C[1],Sheet1!RC[-3])"
          ActiveCell.Offset(1, 0).Select
          
          
           Wend
            Range(temppos).Select
             ActiveCell.Offset(0, 4).Select
             While ActiveCell.Offset(0, -4).Value <> ""
          
            ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('No of dlrs bild LM nt CM'!C[-5],Sheet1!RC[-5],'No of dlrs bild LM nt CM'!C,Sheet1!RC[-4])"
           'test complete
          
        ActiveCell.Offset(1, 0).Select
        Wend
        Range(temppos).Select
             ActiveCell.Offset(0, 5).Select
             While ActiveCell.Offset(0, -5).Value <> ""
        ActiveCell.FormulaR1C1 = _
        "=COUNTIFS('Dlrs abv avg less than dsp%-UH'!C[-6],Sheet1!RC[-6],'Dlrs abv avg less than dsp%-UH'!C[-1],Sheet1!RC[-5])"
          ActiveCell.Offset(1, 0).Select
        Wend
       
         ' Range(temppos).Select
          '   Selection.End(xlDown).Select
            
           '  ActiveCell.Offset(1, 0).Select
            ' ActiveCell.Value = "Total"
            
         
       
       
       
          Range(temppos).Select
         
        '  ActiveCell.Value = ActiveCell.Offset(-1, 0).Value & " Total"
         
          ActiveCell.Offset(0, 1).Select
            Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
   
    Set source = Selection

    nCol = source.Columns.Count
    nRow = source.Rows.Count
    For iCol = 1 To nCol
        With source.Columns(iCol).Rows(nRow).Offset(1, 0)
            .FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
            .Font.Bold = True
        End With
    Next iCol

       
       Range(temppos).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Select
    temppos = ActiveCell.Address
     
     
     ActiveWorkbook.Sheets("Total No. of Dlrs").Select
    
    Range("A1").Select
    On Error Resume Next
   
    ActiveSheet.ShowAllData
     Range("A1").Select
      
   If ActiveSheet.AutoFilterMode Then
   Selection.AutoFilter
   End If
  
     Sheets("temp_data").Select
    Range("A1").Select
    Next i
  ActiveSheet.Columns("A:A").EntireColumn.AutoFit
  Application.CutCopyMode = False
 
  Sheets("Sheet1").Select
  Range("A1").Select
  ActiveCell.Offset(1, 0).Select
  For i = 1 To 15000
 
  If InStr(ActiveCell.Value, "Total") Then
  If ActiveCell.Offset(1, 0).Value = "" Then
  Exit For
  End If
  End If
 
 
  ActiveCell.Offset(1, 0).Select
 
 
 
  Next i
 
   ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = "Grand Total"
           
           ActiveCell.Resize(1, 2).Select
    

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
   
    Dim sourcefinal As Range


Dim count1 As Integer

 Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    count1 = Selection.Rows.Count
  '  MsgBox (count1)
   
On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "temp_data"
Dim temporarystr As String
temporarystr = "A1"




 Sheets("Sheet1").Select

Range("A1").Select


 

For i = 1 To count1 - 1

If InStr(ActiveCell.Value, "Total") <> 0 Then



 

 
 ActiveCell.Offset(0, 1).Select
 Range(Selection, Selection.End(xlToRight)).Select
 Selection.Copy
  ActiveCell.Offset(0, -1).Select
ActiveWorkbook.Sheets("temp_data").Select
Range(temporarystr).Select

 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
  ActiveCell.Offset(1, 0).Select
  temporarystr = ActiveCell.Address
  Sheets("Sheet1").Select

End If
Range("A1").Select
ActiveCell.Offset(i, 0).Select

Next i
ActiveWorkbook.Sheets("temp_data").Select
Range("A1").Select
   Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
       Set sourcefinal = Selection

    nCol = sourcefinal.Columns.Count
    nRow = sourcefinal.Rows.Count
    For iCol = 1 To nCol
        With sourcefinal.Columns(iCol).Rows(nRow).Offset(1, 0)
            .FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
            .Font.Bold = True
        End With
    Next iCol
    Range("a" & nRow + 1).Select
       Range(Selection, Selection.End(xlToRight)).Select
       Selection.Copy
       Sheets("Sheet1").Select
Range("A" & count1).Select
ActiveCell.Offset(0, 1).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
   Columns("A:F").EntireColumn.AutoFit
  
    'Design
  Sheets("Sheet1").Select
 Cells.Select
   
    Selection.ClearFormats
    Application.CutCopyMode = False
   
Range("A1").Select

Dim tempu As String
tempu = "A1"

  Dim tempu2 As String
 

For i = 1 To count1 - 1

If InStr(ActiveCell.Value, "Total") <> 0 Then

 Selection.End(xlToRight).Select
 Selection.End(xlToRight).Select
 tempu2 = Replace(ActiveCell.Address, "$", "") & ":" & Replace(tempu, "$", "")
 Range(tempu2).Select
  With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
     .Bold = True
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 End If
 Range(tempu).Select

 ActiveCell.Offset(1, 0).Select
 tempu = ActiveCell.Address

 Next i
 Range("A1").Select


  'Design end
 
  'Header Design
 
    Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").RowHeight = 42.75
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
       
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
 
 
 
 
 
  'Header Design End
 
   On Error Resume Next
ActiveWorkbook.Sheets("temp_data").Delete

End Sub