Hi so I'm currently trying to sum visible values of a filtered row in Excel using VBA aka using SUBTOTAL. My problem is that the number of rows change depending on the filter. I tried to write a code that loops through the rows until it hits a blank cell, and subtotals the visible rows. Any help would be appreciated
Sub Test1()
Dim x As Integer
NumRows = Range("K15", Range("K15").End(xlDown)).Rows.Count
Range("K15").Select
For x = 1 To NumRows
H14 = SUBTOTAL(9,"K15" : "NumRows")
ActiveCell.Offset(1, 0).Select
Next
End Sub
Something like this? You should check start row (15 here), and cell where sum is written (Cells(14,8) in this case, id est, H8). Also is usually helpful to define worksheet (Data in this case).
Sub Test1()
Dim x As Long
Dim lMySum As Long
Dim NumRows As Long
lMySum = 0
NumRows = Worksheets("Data").Cells(15, 11).End(xlDown).Row
For x = 15 To NumRows
If Not (Worksheets("Data").Rows(x).EntireRow.Hidden) Then
lMySum = lMySum + Worksheets("Data").Cells(x, 11).Value
End If
Next
Worksheets("Data").Cells(14, 8) = lMySum
End Sub
Related
I'm working on an assignment that requires the solution use VBA, so I can't use indexing or other options on the worksheet page... I've looked all over for an answer, maybe I'm just asking the question incorrectly.
In column K there are ticker symbols, i.e. A, ABM, etc.
In column L there is an number (I've been classifying as Long)
I want to put the highest number in column L in Range("O2") and the tag that is one column to the left in Range("N2").
I've found numerous ways to identify the high number in column L, but can not figure out how to return the adjacent cells value...
Here is the most recent code that I've been trying which is not working. When I remove the tag references the code runs fine, but I need the adjacent value too.
Thanks
Sub attempt38()
Dim sheet As Worksheet
Dim i As Long
Dim firstRow As Integer
Dim columnNumber As Integer
Dim max As Long
Dim tag As Long
firstRow = 2
columnNumber = 12
Set sheet = ActiveSheet
If sheet.UsedRange.Rows.Count <= 1 Then max = 0 Else max = sheet.Cells(2, 12)
For i = firstRow To 300
If sheet.Cells(i, 12) > max Then max = sheet.Cells(i, 12) & (tag = sheet.Cells(i, 11))
Next
sheet.Cells(3, 14) = max
sheet.Cells(4, 14).Value = tag
End Sub
You don't need VBA. You can just use regular excel.
=LARGE(L:L,1)
Will return the largest number.
To get the corresponding just use Index plus match.
=INDEX(K:K,MATCH(LARGE(L:L,1),L:L,FALSE),1)
If you really want to use VBA, adjust your code to be two lines like so:
For i = firstRow To 300
If sheet.Cells(i, 12) > max Then
max = sheet.Cells(i, 12)
tag = sheet.Cells(i, 11)
Endif
Next
Or if you want to look sophisticated:
For i = firstRow To 300
With sheet.Cells(i, 12)
If .Value > max Then
max = .Value
tag = .Offset(0,-1).Value
Endif
End With
Next i
Looping through a range can be time consuming and, in this case, also wasteful.
What if your max value actually exists in the first looped row? You will now loop through 299 rows for nothing.
The below method will be much faster and requires no loops.
Option Explicit
Sub Mad_Max()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim MyMax As Long, MaxCell As Range
MyMax = Application.WorksheetFunction.Max(ws.Range("L:L"))
Set MaxCell = ws.Range("L:L").Find(MyMax, Lookat:=xlWhole)
ws.Range("N3") = MyMax
ws.Range("N4") = MaxCell.Offset(, -1)
End Sub
Suppose that I have Excel file consists of four worksheets, lets name them as 1, 2, 3 and 4. I want to evaluate a sum of all values from the cells AK10, AK25, AK40 and so on till AK160 on the worksheet 4 and then place it in the cell G23 of worksheet 2.
Here is my macro that I assign to worksheet 2:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = WorksheetFunction.Sum(s, Worksheets("4").Range("AK(10 + 15 * i)"))
Next i
Range("G23").Value = "s"
End Sub
It ends up with 400 error. What am I doing wrong?
Sub sum_up()
Dim i As Long, s As Long
s = 0
For i = 0 To 10
s = s + Worksheets("4").Cells(10 + 15 * i, "AK").Value
Next i
Range("G23").Value = s
End Sub
I'll take a crack at this - I'd really use a lot more named ranged to pass data back and forth...:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = s + Worksheets("4").Range("AK" & (10 + 15 * i))
Next I
Range("G23").Value = s
End Sub
you did not say that the summation was to be done using VBA
put this in G23 on worksheet2 (actually, put this in any cell)
=SUM('4'!AK10,'4'!AK25,'4'!AK40,'4'!AK55,'4'!AK70,'4'!AK85,'4'!AK100,'4'!AK115,'4'!AK130,'4'!AK145,'4'!AK160)
as far as what you are doing wrong with your code, that has partly been answered by #KenWhite
you are also putting the letter "s" into G23 of any worksheet that happens to be visible at the time your code runs
put in a reference to sheet 2, same as you referenced sheet 4 just two lines above
this code should work:
Sub sum_up()
Dim ws4 As Worksheet
Set ws4 = ActiveWorkbook.Sheets("4")
Dim rng As Range
Set rng = ws4.Range("ak10") ' point to "ak10"
Dim total As Long
total = rng.Value
Do While True
rng.Select
Set rng = rng.Offset(15) ' move pointer down 15 rows
If rng.Row > 160 Then Exit Do ' moved past row 160 ?
total = total + rng.Value
Loop
ActiveWorkbook.Sheets("2").Range("G23").Value = total
End Sub
I have a table with time values. If any value exists in a specified row that is greater than 90 minutes (1:30:00), I need to add the difference (i.e. how much greater it is) to a running total at the end of the row. So, that box could be blank, could have just one cell's value, or could have multiple values added. I already have the For loop to go through each cell in a row. I need the part to sum the values. And ideally, if there was a nested loop to do 6 separate sums for the 6 rows...
'Add break munutes
fp.Activate
Dim rng As Range
For Each rng In Range("B3:F3")
If rng.Value > TimeValue("1:31:00") Then
End If
Next rng
If you want to avoid VBA, this can actually be done by an Excel formula:
=SUMIF($B$3:$B$9,">"&1.5/24)-COUNTIF($B$3:$B$9,">"&1.5/24)*1.5/24
That sums up all values that exceed 90 minutes, and then subtracts off 90 minutes from the total for each value that has been counted.
I would recommend Excel Formula if that is an option, because of the restrictions of VBA solutions.
=SUMPRODUCT((B$3:B9-1/16)*(B$3:B9>1/16))
or a bit shorter with array formula (enter with Ctrl + Shift + Enter) :
=SUMIF(B$3:B9-1/16,">0")
Hard to say if this is fully accurate without more information, but something like this should work for you:
Sub tgr()
Dim aTimes As Variant
Dim dTime As Double
Dim aSumResults() As Double
Dim lResultIndex As Long
Dim i As Long, j As Long
Dim bFirst As Boolean
dTime = TimeValue("01:00:00")
aTimes = ActiveSheet.Range("B3:F9").Value 'Change to the full table range
ReDim aSumResults(1 To UBound(aTimes, 1) - LBound(aTimes, 1) + 1, 1 To 1)
For i = LBound(aTimes, 1) To UBound(aTimes, 1)
'Each i represents a row of the data
'Go through each column and collect the conditional sums
lResultIndex = lResultIndex + 1
bFirst = True 'Use bFirst to ignore first value greater than dTime
For j = LBound(aTimes, 2) To UBound(aTimes, 2)
If aTimes(i, j) > dTime Then
If bFirst Then
'This if the first value found for the row, ignore it
bFirst = False
Else
'Not the first value found, include in sum
aSumResults(lResultIndex, 1) = aSumResults(lResultIndex, 1) + aTimes(i, j) - dTime
End If
End If
Next j
Next i
'Output the results
ActiveSheet.Range("G3").Resize(UBound(aSumResults, 1)).Value = aSumResults
End Sub
You said you wanted the sum of the times in a row but then defined B3:B9, so I assumed you meant the sum of the times in a column.
Try this:
Dim i As Integer
Dim num1 As Date
For i = 3 To 9
If Cells(i, 2).Value > TimeValue("1:30:00") Then
num1 = Cells(10, 2).Value + Cells(i, 2).Value - TimeValue("1:30:00")
Cells(10, 2).Value = num1
End If
Next i
I've defined where the sum is put as cell B10. You could make a similar loop for each column. I tried this out and it worked for me.
I am trying to count the number of cells in a range that has the same color as a reference cells, IF the corresponding cell in another range has the correct value criterion. For example:
If (A1 < 350) and (B1 has the same color as a reference cell), then count 1.
Loop over rows 1 to 15
It is essentially the same problem as the question posted here:
http://www.mrexcel.com/forum/excel-questions/58582-countif-multiple-criteria-one-being-interior-color.html
Unfortunately, it seems that the ExtCell.zip file no longer exit. Hence, I could not simply replicate the given solution. I tried to follow the same approach using the SUMPRODUCT function and I wrote a function for comparing cell color, but it did not work. I got the error "A value used in the formula is of the wrong data type." My code is as follow. I am using Excel 2007 on Windows 7. Any help is appreciated. Thanks!
=SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))
The formula above is keyed into a cell. B57:B65 contain some numerical values, while D57:D65 are colored cells. D307 is the reference cell with the correct color.
'' VBA function ColorCompare
Function ColorCompare(refCell As Range, compareCells As Range) As Variant
Dim rCell As Range
Dim TFresponses() As Boolean 'the boolean array to be returned to SUMPRODUCT
Dim CallerCols As Long 'find out the number of cells input by the user
'so as to define the correct array size
With Application.Caller
CallerCols = .Column.Count
End With
ReDim TFresponses(1 To CallerCols)
Dim Idx As Long
Idx = 1
For Each rCell In compareCells
If rCell.Interior.ColorIndex = refCell.Interior.ColorIndex Then
TFresponses(Idx) = 1
Idx = Idx + 1
Else
TFresponses(Idx) = 0
Idx = Idx + 1
End If
Next rCell
ColorCompare = TFresponses
End Function
There are a couple of issues in your code
You need to determine the size of compareCells, not the caller cell
You are considering columns, should be Rows (or Rows and Columns for maximum flexability)
There are a few optimisations you can make
Here's a refactored version of your Function
Function ColorCompare(refCell As Range, compareCells As Range) As Variant
Dim rCell As Range, rRw As Range
Dim TFresponses() As Boolean 'the boolean array to be returned to SUMPRODUCT
Dim rw As Long, cl As Long
Dim clr As Variant
clr = refCell.Interior.ColorIndex
ReDim TFresponses(1 To compareCells.Rows.Count, 1 To compareCells.Columns.Count)
rw = 1
For Each rRw In compareCells.Rows
cl = 1
For Each rCell In rRw.Cells
If rCell.Interior.ColorIndex = clr Then
TFresponses(rw, cl) = True
End If
cl = cl + 1
Next rCell
rw = rw + 1
Next rRw
ColorCompare = TFresponses
End Function
Note that while this will return a result for any shaped range, to be useful in SumProduct pass it a range either 1 row high or 1 column wide - just as your sample formula does.
Try this (updated for given formula: =SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))):
Sub test()
i = 57
While Not IsEmpty(Cells(i, 1))
If Cells(i, 2) < 350 And Cells(i, 4).Interior.ColorIndex = Cells(307, 4).Interior.ColorIndex Then 'replace with your reference cell
count = count + 1
End If
i = i + 1
Wend
End Sub
I am trying to create a macro that will find the maximum value (i.e. the largest) for specific columns in row.
Figure 1:
For example, In FIGURE 1 I have shown a simple example table ranging A1 to K12. Where the top 2 rows represent ‘Height’ and ‘Year’ respectively. And they are always in ascending order. The figure shows 2 years data and I am trying to create the maximum for each height between years. I have highlighted in red text what I am trying to do. For example, cell L3 is the Max of B3 and G3 (i.e. =MAX(B3,G3)) and similarly all the cells for range L3:P12 in red are the maximum values for each heights.
I know I can do this easily just by manually calculating using Max(cell1,cell2) function or by using the following Macro:
Sub test()
Range("G1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MAX(RC[-10],RC[-5])"
Range("L3").Select
Selection.AutoFill Destination:=Range("L3:P3"), Type:=xlFillDefault
Range("L3:P3").Select
Selection.AutoFill Destination:=Range("L3:P12")
Range("L3:P12").Select
End Sub
But my actual table is far more larger with many more years of data with more heights and I will be running this in a loop for many spreadsheets. There for the number of rows and columns can vary. So I am just wondering how I can adopt a dynamic argument that will dynamically calculate the max based on the top two rows (i.e. height and year).
I was thinking if any way I could set a range for the top row as the height will be always increasing until the next year when it restart from the lowest value again. My plan was to then try to put some conditions to calculate the max values and autofill the range. But I am just not able to even define the range as I am strugling to logically plan this code. The following is what I have tried and I would really appreciate any guidance on how logically I could achieve this problem. Many thanks in Advance!
Sub test()
Dim LR As Long, i As Long, r As Range
LR = Range("1" & Columns.Count).End(xlToRight)
For i = 1 To LR
If Range("1" & i).Value > 10 Then
If r Is Nothing Then
Set r = Range("1" & i)
Else
Set r = Union(r, Range("1" & i))
End If
End If
Next i
r.Select
End Sub
Due to the unlimited possibility of height values, using a class was the best solution that I could think of for now. Hopefully this provides a good foundation to build from.
In a class module named 'HeightClass':
Option Explicit
Dim rngRangeStore As Range
Dim sValueStore As String
Public Property Set rngRange(rngInput)
Set rngRangeStore = rngInput
End Property
Public Property Get rngRange() As Range
Set rngRange = rngRangeStore
End Property
Public Property Let sValue(sInput As String)
sValueStore = sInput
End Property
Public Property Get sValue() As String
sValue = sValueStore
End Property
Then in a standard Module:
Option Explicit
Sub Get_Max()
Dim lRecord As Long, lRange As Long, lLastRecord As Long, lLastColumn As Long
Dim colRanges As New Collection
Dim clsRange As HeightClass
'Find Last used column in the year row
lLastColumn = Rows(2).Find(What:="*", SearchDirection:=xlPrevious).Column
'Find last used row in column 1
lLastRecord = Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Row
For lRange = 2 To lLastColumn
On Error Resume Next
Set clsRange = Nothing
Set clsRange = colRanges(Trim$(Cells(1, lRange).Value))
On Error GoTo 0
If Not clsRange Is Nothing Then
'Add to existing range
Set clsRange.rngRange = Union(clsRange.rngRange, Cells(1, lRange))
Else
'Add range to colletion in order of smallest to largest
Set clsRange = New HeightClass
Set clsRange.rngRange = Cells(1, lRange)
clsRange.sValue = Cells(1, lRange).Value
If colRanges.Count = 0 Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue
Else
For lRecord = 1 To colRanges.Count
If clsRange.sValue < colRanges(lRecord).sValue Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue, Before:=colRanges(lRecord).sValue
Exit For
ElseIf lRecord = colRanges.Count Then
colRanges.Add Item:=clsRange, Key:=clsRange.sValue, After:=colRanges(lRecord).sValue
Exit For
End If
Next lRecord
End If
End If
Next lRange
'Place height headers
For lRange = 1 To colRanges.Count
With Cells(1, lLastColumn + lRange)
.Value = colRanges(lRange).sValue
.Font.Color = vbRed
End With
Next lRange
'Process each record
For lRecord = 3 To lLastRecord
For lRange = 1 To colRanges.Count
With Cells(lRecord, lLastColumn + lRange)
.Value = Application.Max(colRanges(lRange).rngRange.Offset(lRecord - 1))
.Font.Color = vbRed
.NumberFormat = "0.00"
End With
Next lRange
Next lRecord
End Sub
This is written to perform the desired process on whatever sheet is in focus.
So the array formula (enter it with Ctrl+Shift+Enter)version would be, in L3 etc.:
=MAX(IF($B$1:$K$1=L$1,$B3:$K3,""))
It says:
look in the headers $B$1:$K$1 to check a match for your column's height (=L$1)
if it matches, take the value ,$B3:$K3
otherwise ignore it ,""
take the MAX of those non-ignored values
I tried this with 100 columns (5 heights * 20 years) and 1000 rows of RAND produced random numbers and the recalculation time was negligible