filter data and find count and sum using vba,Sourav Bhattacharya ,Excel VBA Teacher

Sub setlistbox()

Workbooks("Macro_1.xlsm").Activate
ActiveWorkbook.Sheets("DATABASE").Activate
    Range("AJ3").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
  
    Range("AI3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AJ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AJ3").Select
   
    Dim myrange As Range
    Range(Selection, Selection.End(xlDown)).Select
    Set myrange = Selection
    'MsgBox (myrange.Address)
   
    ActiveSheet.Range(myrange.Address).RemoveDuplicates Columns:=1, Header:=xlNo

    Range("AJ3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Dim options() As String
    ReDim options(Selection.Rows.count) As String
     Dim cell As Object
    Dim count As Integer
    count = 1
    For Each cell In Selection
        options(count) = cell.Value
        count = count + 1
       
    Next cell
    'MsgBox Selection.Rows.count
    For count = 1 To UBound(options)
    'MsgBox (options(count))
    Next count
   
   
   
    ActiveCell.EntireColumn.Delete
    ActiveWorkbook.Sheets("2nd Macro").Activate
    Columns("B:B").Select
    Selection.NumberFormat = "@"
   
    Range("B6").Select
    For i = 1 To UBound(options)
Sheet2.ListBox1.AddItem options(i)

Next i


End Sub

Sub almostfinal()
Dim countarr() As Integer

Dim str1 As String

Workbooks("Macro_1.xlsm").Activate

  ActiveWorkbook.Sheets("2nd Macro").Activate
  
    Range("B6:C200").Select
    Selection.Clear
 
    Range("C1:AG1500").Select
    Selection.Clear
   
   Dim source As Range
    Dim iCol As Long
    Dim nCol As Long
    Dim nRow As Long
  'Dim text As String
  Dim count1 As Integer
  Dim i As Integer
  Dim j As Integer
 
  count1 = 0
   Sheets("2nd Macro").Select
    Columns("B:B").Select
    Selection.NumberFormat = "@"
 
  Range("B6").Select
 
    For i = 0 To Sheet2.ListBox1.ListCount - 1
        If Sheet2.ListBox1.Selected(i) = True Then
       ActiveCell.Value = Sheet2.ListBox1.List(i)
       ActiveCell.Offset(1, 0).Select
       count1 = count1 + 1
      
        End If
    Next i
   ' MsgBox (count1)
   If count1 = 0 Then
    Range("B6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
     Range("B6:C200").Select
    Selection.Clear
 
    Range("C1:AG1500").Select
    Selection.Clear
   
    Exit Sub
   
    End If
   
   
   ' MsgBox "Selected items are: " & text
     Columns("B:B").EntireColumn.AutoFit
    
     Application.DisplayAlerts = False
On Error Resume Next
Sheets("temp_data").Delete



Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "temp_data"

ActiveWorkbook.Sheets("temp_data").Select
   
    Columns("A:A").Select
    Selection.NumberFormat = "@"
   
  ActiveWorkbook.Sheets("2nd Macro").Activate
  Range("B5").Select
  Dim pos1 As String
  Dim filterstr As String
  ReDim countarr(count1) As Integer
 
  For i = 1 To count1
 
  
  Range("B5").Select
    Sheets("temp_data").Select
    Range("B1").Select
    Dim signal As Integer
    signal = 0
   
   
      
  ActiveWorkbook.Sheets("2nd Macro").Activate
  Range("B5").Select
  For j = 1 To i
  
   ActiveCell.Offset(1, 0).Select
  
 
  Next j
 
  pos1 = ActiveCell.Address
 ' MsgBox ("pos1" & pos1)
 
    Range("B5").Select
  
ActiveCell.Offset(0, 1).Select
ActiveCell.EntireColumn.Insert
    Range("B5").Select
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range(pos1).Select
   
   
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    pos2 = ActiveCell.Address
   ' MsgBox ("pos2" & pos2)
   
    Range(pos2).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   ' MsgBox ("check")
  
        Range("C5").Select
        str1 = "$c$5:"
       
        For j = 1 To count1
        ActiveCell.Offset(1, 0).Select
       
       
        Next j
       
        str1 = str1 & ActiveCell.Address
       
    Range(str1).Select
    Selection.Copy
    ActiveWorkbook.Sheets("temp_data").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Range("a2").Select
    For j = 1 To count1
    If ActiveCell.Value <> "" Then
Range("a2").Value = ActiveCell.Value

    End If
    ActiveCell.Offset(1, 0).Select
   
    Next j
   
  '  Columns("A:A").Select
  '  Selection.SpecialCells(xlCellTypeBlanks).Select
'    Selection.EntireRow.Delete
   
    'now the filtering part
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$" & 100).RemoveDuplicates Columns:=1, Header:=xlYes
       ActiveWorkbook.Sheets("DATABASE").Select
     Range("A2:AI100").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("temp_data").Range("A1:A2"), Unique:=False

    Range("I2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("temp_data").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        'filtering ends
       
     Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    
countarr(i) = (Selection.Rows.count)

    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

     Sheets("temp_data").Select
    Range("B1").Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlToRight)).Select
   
    Selection.Copy
   
     Sheets("2nd Macro").Select
    Range(pos2).Select
    ActiveCell.Offset(0, 5).Select
   
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      ActiveWorkbook.Sheets("2nd Macro").Activate
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
      ActiveWorkbook.Sheets("DATABASE").Activate
       Range("A3").Select
    ActiveSheet.ShowAllData
    
      ActiveWorkbook.Sheets("temp_data").Activate
      Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Clear
  Next i
    ActiveWorkbook.Sheets("2nd Macro").Activate
    Range("c5").Select
    ActiveCell.Value = "count"
    ActiveCell.Offset(1, 0).Select
   
  For i = 1 To count1
 ActiveCell.Value = countarr(i) - 1
 ActiveCell.Offset(1, 0).Select

  Next i
  For i = 1 To count1
  countarr(i) = 0
  Next i
 
   Sheets("DATABASE").Select
    Range("I2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("2nd Macro").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
    
End Sub


Sub testpos()

Workbooks("Macro_1.xlsm").Activate

  ActiveWorkbook.Sheets("2nd Macro").Activate
 Dim j As Integer
  Dim i As Integer
 
For i = 1 To 4
  Range("B5").Select
  For j = 1 To i

  ' MsgBox (ActiveCell.Address)
   ActiveCell.Offset(1, 0).Select
  
 
  Next j
  MsgBox (ActiveCell.Address)
  Next i
 

End Sub