Snasui Excel Forum

Code: Select all

Sub FilterDataAll()
'On Error Resume Next
  Dim rSource As Range
  Dim rTarget As Range
  Dim r As Range
  Dim lng As Long
  With Sheets("Report")
      If .Range("A8") <> "" Then
          .Range("A8", .Range("A" & Rows.Count)).Resize(, 6).ClearContents
          .Range("E8") = "จ่าย"
          .Range("F8") = "คงเหลือ"
      End If
  End With
  With Sheets("TaxInvoice")
      Set rSource = .Range("B2:H" & Rows.Count)
  End With
  rSource.AdvancedFilter Action:=xlFilterInPlace, _
      CriteriaRange:=Sheets("Report").Range("K1:M2")
  rSource.Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
  Sheets("Report").Range("A8").PasteSpecial xlPasteValues
  If Sheets("Report").Range("B9") = "" Then Exit Sub
  With Sheets("Report")
    Set rTarget = .Range("B9", .Range("B" & Rows.Count).End(xlUp))
  End With
  For Each r In rTarget
    r.Offset(0, 3) = Application.SumIf(Range("Data_Tax"), r, Range("Data_Amount"))
    If r.Row = 9 Then
        r.Offset(0, 4) = Range("G3") + r.Offset(0, 2)
    Else
        r.Offset(0, 4) = r.Offset(0, 2) + r.Offset(-1, 4)
    End If
  Next r
  Sheets("TaxInvoice").ShowAllData
End Sub