daily pastebin goal
7%
SHARE
TWEET

Untitled

a guest Dec 6th, 2018 48 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Test()
  2.     Dim LR As Long
  3.     Dim Total As Variant
  4.  
  5.     With Worksheets("Sheet1")
  6.          LR = .Cells(.Rows.Count, "A").End(xlUp).Row
  7.          Total = Application.WorksheetFunction.SumIf(.Range("A2:A" & LR), "<>Test", .Range("B2:B" & LR))
  8.     End With
  9. End Sub
  10.    
  11. vntArr = objRng
  12.    
  13. '*******************************************************************************
  14. 'Purpose:   Sums up a range of values excluding the values of cells where
  15. '           another cell in the same row contains a specified value.
  16. '*******************************************************************************
  17. Sub SumifArray()
  18.  
  19.   Const cstrName As String = "Sheet1" 'Name of the worksheet to be processed
  20.   Const cLngFirstRow As Long = 2 'First row of data (excluding headers)
  21.   Const cStrSumColumn As String = "B" 'The column to sum up
  22.   Const cStrCheckColumn As String = "A" 'The column where to check against
  23.   Const cStrCheckString As String = "Test" 'The value to be checked against
  24.  
  25.   Dim objRng As Range 'The range of data (both columns)
  26.   Dim vntArr As Variant 'The array where the range is to be pasted into
  27.   Dim lngLastRowCheck As Long 'Calculated last row of data in the "check" column
  28.   Dim lngLastRowSum As Long 'Calculated last row of data in the "sum" column
  29.   Dim lngArrCounter As Long 'Array row counter
  30.   Dim lngSum As Long 'Value accumulator
  31.  
  32.   With Worksheets(cstrName)
  33.     ' Last used row in column cStrCheckColumn
  34.     lngLastRowCheck = .Columns(cStrCheckColumn).Find(What:="*", _
  35.         After:=.Cells(1, cStrCheckColumn), LookIn:=xlFormulas, _
  36.         Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  37.     ' Last used row in column cStrSumColumn
  38.     lngLastRowSum = .Columns(cStrSumColumn).Find(What:="*", _
  39.         After:=.Cells(1, cStrSumColumn), LookIn:=xlFormulas, _
  40.         Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  41.   End With
  42.  
  43.   ' Calculate the range of data
  44.   Set objRng = Range(Cells(2, cStrCheckColumn), _
  45.       Cells(lngLastRowCheck, cStrSumColumn))
  46.   ' Paste the range of data into an array (One-based, two-dimensional)
  47.   vntArr = objRng
  48.   ' Release object variable: the data is in the array
  49.   Set objRng = Nothing
  50.  
  51.   ' Loop through the array
  52.   For lngArrCounter = LBound(vntArr) To UBound(vntArr)
  53.     ' Check if the value in the "check" column isn't equal to cStrCheckString
  54.     If vntArr(lngArrCounter, 1) <> cStrCheckString Then _
  55.         lngSum = lngSum + vntArr(lngArrCounter, 2)
  56.   Next
  57.  
  58.   ' Write the result into the first empty row after the last row of data in
  59.   ' the "sum" column
  60.   Worksheets(cstrName).Cells(lngLastRowSum + 1, cStrSumColumn) = lngSum
  61.  
  62. End Sub
  63.    
  64. Sub test()
  65. 'i suppose the name are on the A coloumn and the value are in b coloumn
  66. Dim rows As Integer
  67. Dim sum As Double
  68.  
  69. sum = 0
  70.  
  71. 'count how many rows
  72. rows = ActiveSheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count
  73.  
  74. For i = 2 To rows
  75.  
  76.     'sum the value
  77.     sum = sum + Cells(i, 2) 'column B value
  78.  
  79. Next i
  80.  
  81. 'subtract the item focused
  82. sum = sum - Cells(ActiveCell.Row, 2)
  83.  
  84. 'write sum in the last row (column B)
  85. Cells(rows + 1, 2) = sum
  86.  
  87. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top