Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.
Related
i need to multiply all cells within a range. The number i need to multiply by is looked up in a different tab called initial machine prices. Within the range each line item has a quote date, this is what is required to be used for the lookup as i can lookup up the date against the annual % increase (in the initial machine prices tab). For example i need the vba to multiply all cells in the first row by 1.02% as the quote year is 2020, i then need it to go the the row below and multiply all cells by 1.0404% because the quote year is 2019.
The Top image shows the % table and then last table shows the values that are required to be changed
Below is what i have started with but only multiplies all cells by 1 number.
Sub Multiply_vals()
Dim ws As Worksheet
Dim rng As Range
Dim myVal As Range
Set ws = Worksheets("Epp mould")
Set rng = ws.Range("V4:AC46")
For Each myVal In rng
myVal = myVal.Value * 2
Next myVal
End Sub
Using the newer dynamic features (afaik versions 2019+ or MS365),
and assuming that the correct factor for the first row is
1.02% (cell EA2), the row below 1.0404% (cell EAB) etc. to the right in sheet `Initial Maching prices',
you can
use a (worksheet related) formula evaluation
referring to your source data in cells V4:AC43,
multiplied by the transposed factors (making them vertical) in sheet 'Initial Machine Prices' and
overwrite the originals by the recalculated array values
Note that this would overwrite existing data, so copy your source values to a backup sheet before!
Option Explicit ' declaration head of code module
Sub Example()
'0) fully qualify data source sheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
'1) get data to array via formula evaluation
' (multiplying source values with factors in Initial Machine Prices)
Dim data
data = ws.Evaluate("V4:AC43*TRANSPOSE(OFFSET('Initial Machine Prices'!EA2,,,,ROWS(V4:AC43)))")
'2) overwrite existing data(!)
ws.Range("V4").Resize(UBound(data, 1), UBound(data, 2)) = data
End Sub
If cell in Range("H1:H104000") is "" Then
Range("H1:H104000) = LEFT(Range("D1:D104000), 3
End If
This is the code I am trying with no success.
You're missing the Loop. You need to write the loop to iterate through the collection of cells, the code can't do it implicitly even if you compare a single range to a collection of ranges.
Also, to compare values use =. The Is operator is only used for Objects.
Dim Cell As Range
For Each Cell In Range("H1:H104000").Cells
If Cell.Value = "" Then
Cell.Value = Right(Cell.Offset(0, -4).Value, 3)
End If
Next
Once you're iterating through the column H. An easy way to refer to "column D in the current row" is by using Offset, which will return a cell, relative to your given starting position. In this case, we just need to move 4 columns to the left so I do .Offset(0,-4)
You might consider
assigning a worksheet related formula evaluation to a variant datafield array data and
writing data back to the referenced column H instead of looping through the given range; this approach lasts only a fraction of a second while the loop through each cell by means of VBA needs several seconds:
Option Explicit ' head of code module
Sub ExampleCall()
Dim t As Double: t = Timer ' start timer
Dim ws As Worksheet
Set ws = Sheet1 ' << change to your project's sheet Code(Name)
Dim data As Variant ' provide for a 1-based 2-dim datafield array
'assign worksheet related evaluation to data
data = ws.Evaluate("=If(IsBlank(H2:H104000),Right(D2:D104000,3),H2:H104000)")
'write to target
ws.Range("H2").Resize(UBound(data), 1).Value = data
Debug.Print Format(Timer - t, "0.00 secs") ' 0.20 secs
End Sub
Further note A worksheet related evaluation via ws.Evaluate(...) guarantees a fully qualified range reference, whereas Evaluate(...) would need more detailed range indications like Sheet1!H2:H104000 or a further textual insertion of ws.Range("H2:H104000").Address(External:=True) to the formula string.
Worksheet1:
Excel sheet
New
Worksheet 1 has licences with 6 columns of information - two being the start and end date.
I need a method of extracting all the records that are within 90 days before the expiry date- the idea being I want a separate alert page
I have done a IF statement that is on the end of the columns that just prints 1 if date is hits the alert criteria or 0 if not...The idea now in Worksheet2 I need some sort of VLOOKUP and IF to extract those records automatically.
How would I do this?
=IF(IFERROR(DATEDIF(TODAY(),H5,"d"),91)<90,1,0)
While use of Pivot table or VBA macro is recommended in such cases, if you absolutely need to use the formula then you may use the below trick.
You already have the Binary column. Now, add another column say Cumulative Binary that will sum all the 1's till the current row using a SumIf formula as shown in the screenshot below (it is fine if some numbers are repeated because of 0's)
The formula in I3 in my workbook is
=SUMIF(H$3:H3,1,H$3:H3)
and you may adjust it as per your needs.
Now, it is easy since each row has a unique number, we could use Vlookup or like I have done here i.e. use Offset function which simply matches the value in the "Lookup Column" to the value in "Cumulative Binary" column and returns the rows that match.
=IFERROR(OFFSET($F$2,MATCH(M3,$I$3:$I$9,0),0,1,2),"")
Please note that it is an array formula as I need to return multiple columns (2 here). So, I selected two columns N,O as shown in the screenshot wrote the formula and used Ctrl+Shift+Enter (instead of Enter). Then I simply dragged the formula down. You may want to adjust it as per your needs by including more columns.
If you can use VBA, you may write some code like this:
Option Explicit
Public Sub CopyCloseToExpiration()
Dim rngSource As Range: Set rngSource = ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Resize(LastRow(ThisWorkbook.Worksheets("Sheet1")) - 1, 9)
Dim rngDestinationTopLeft As Range: Set rngDestinationTopLeft = ThisWorkbook.Worksheets("Sheet2").Cells(LastRow(ThisWorkbook.Worksheets("Sheet2")) + 1, 1)
Dim datLimit As Date: datLimit = DateAdd("d", 90, Date)
CopyBeforeDate rngSource, rngDestinationTopLeft, datLimit
End Sub
Public Sub CopyBeforeDate(rngSource As Range, rngDestinationTopLeft As Range, datLimit As Date)
Dim lngOffset As Long: lngOffset = 0
Dim rngRow As Range: For Each rngRow In rngSource.Rows
If rngRow.Cells(1, 8).Value < datLimit Then
rngDestinationTopLeft.offset(lngOffset, 0).Resize(rngRow.Rows.Count, rngRow.Columns.Count).Value = rngRow.Value
lngOffset = lngOffset + 1
End If
Next
End Sub
Public Function LastRow(ewsSheet) As Long
With ewsSheet
Dim lngResult As Long: lngResult = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
LastRow = lngResult
End Function
You have to put the above into a new Module, customize it (e.g. replace "Sheet1" with the name of you worksheet's actual name), and run it (You can place the caret on the sub CopyCloseToExpiration and hit F5 or place a button somewhere and call this function from its event handler).
i got some countifv thats counts visible and sumifsv which sum visible cells only ... i want sumif only visible using vba
Default Using SUMIFS on visible lines only
I have a large table, lots of rows and lots of columns that has material (Sand, stone, etc.) batched information. I wanted to be able to allow the user to use filters to select which data they want to view, then be able to review some summary information (totals by hour of the day, totals by material, etc.) on other sheets.
I had it working really well and fast using DSUM and/or SUBTOTAL, but these functions don't exclude non-visible (Filtered) lines in a list.
Using some previous posts I saw on this site, I was able to come up with something that works, but it is extremely slow.
I was hoping that more experienced folks could advise me on something that was faster.
What I need to do is to take a list of records on a sheet that contain up to 30 material columns of information (Target and Actual batch weight amounts.) I need to group each of these lines by material into a relative time bucket (12:00 AM to 12:59 AM, 1:00 AM to 1:59 AM, etc.) The user can of course select with Time Bucket they want to view
I am using the sumifs function with two critieria ( i.e. Time >=12:00 and Time < 1:00 ) to get the hourly buckets.
You can also see from this code that I have to count the number of lines for the data and each criteria value because I could not figure out how to set the range of "B" & "C" without counting. Since I am using a filter, I know that the ranges (from a row perspective) of A,B & C are the same, just the relative columns are different. I tried to use the offset function, (i.e. Range(B) = Range(A).Offset(-1,0).Select or B = A.offset(-1,0).Select but they failed for some reason, and no error messages either. I think I somehow turned the erroring off.
Anyway, long story, really could use some help. Here is the related code:
Function Vis(Rin As Range) As Range
'Returns the subset of Rin that is visible
Dim Cell As Range
'Application.Volatile
Set Vis = Nothing
For Each Cell In Rin
If Not (Cell.EntireRow.Hidden Or Cell.EntireColumn.Hidden) Then
If Vis Is Nothing Then
Set Vis = Cell
Else
Set Vis = Union(Vis, Cell)
End If
End If
Next Cell
End Function
Function SUMIFv(Rin As Range, CriteriaRange1 As Range, CriteriaValue1 As Variant, CriteriaRange2 As Range, CriteriaValue2 As Variant) As Long
'Same as Excel SUMIFS worksheet function, except does not count
'cells that are hidden
Dim A1() As Range
Dim B1() As Range
Dim C1() As Range
Dim Csum As Long
' First count up the number of ranges
Cnt = 0
For Each A In Vis(Rin).Areas
Cnt = Cnt + 1
Next A
ReDim A1(1 To Cnt)
ReDim B1(1 To Cnt)
ReDim C1(1 To Cnt)
CntA = 1
For Each A In Vis(Rin).Areas
Set A1(CntA) = A
CntA = CntA + 1
Next A
CntB = 1
For Each B In Vis(CriteriaRange1).Areas
Set B1(CntB) = B
CntB = CntB + 1
Next B
CntC = 1
For Each C In Vis(CriteriaRange2).Areas
Set C1(CntC) = C
CntC = CntC + 1
Next C
If CntA <> CntB Or CntB <> CntC Then
MsgBox ("Error in Sumifs Function: Counts from Ranges are not the same")
End If
Csum = 0
For Cnt = 1 To CntA - 1
Csum = Csum + WorksheetFunction.SumIfs(A1(Cnt), B1(Cnt), CriteriaValue1, C1(Cnt), CriteriaValue2)
Next
SUMIFv = Csum
End Function
((countifv visible cells only
If you are interested, here is a more general COUNTIF solution, and one that you can also apply to SUM and other functions that operate on ranges of cells.
This COUNTIFv UDF uses the worksheet function COUNTIF to count visible cells only, so the Condition argument works the same as with COUNTIF. So you can use it just as you would COUNTIF:
=COUNTIFv(A1:A100,1)
Note that it uses a helper function (Vis) that returns the disjoint range of visible cells in a given range. This can be used with other worksheet functions to cause them to operate only on the visible cells. For example,
=SUM(Vis(A1:A100))
yields the sum of the visible cells in A1:A100. The reason why this approach of using Vis directly in the argument list does not work with COUNTIF is that COUNTIF will not accept a disjoint range as an input, whereas SUM will.
Here's the UDF code:
Function Vis(Rin As Range) As Range
'Returns the subset of Rin that is visible
Dim Cell As Range
Application.Volatile
Set Vis = Nothing
For Each Cell In Rin
If Not (Cell.EntireRow.Hidden Or Cell.EntireColumn.Hidden) Then
If Vis Is Nothing Then
Set Vis = Cell
Else
Set Vis = Union(Vis, Cell)
End If
End If
Next Cell
End Function
Function COUNTIFv(Rin As Range, Condition As Variant) As Long
'Same as Excel COUNTIF worksheet function, except does not count
'cells that are hidden
Dim A As Range
Dim Csum As Long
Csum = 0
For Each A In Vis(Rin).Areas
Csum = Csum + WorksheetFunction.CountIf(A, Condition)
Next A
COUNTIFv = Csum
End Function ))
this both are countif and sumifs with visible cells but i need sumif not sumifs please edit the 2nd code and compile and post the correct program :)
I don't think this is correct...
......................................using DSUM and/or SUBTOTAL, but
these functions don't exclude non-visible (Filtered) lines in a list.
The behaviour for SUBTOTAL is different for "filtered" and "hidden" rows.
This is from the excel help:
For the function_num constants from 1 to 11, the SUBTOTAL function
includes the values of rows hidden by the Hide Rows command under the
Hide & Unhide submenu of the Format command in the Cells group on the
Home tab in the Excel desktop application. Use these constants when
you want to subtotal hidden and nonhidden numbers in a list. For the
function_Num constants from 101 to 111, the SUBTOTAL function ignores
values of rows hidden by the Hide Rows command. Use these constants
when you want to subtotal only nonhidden numbers in a list.
The SUBTOTAL function ignores any rows that are not included in the
result of a filter, no matter which function_num value you use.
i have got a question about referencing a cell in other worksheet.
I have got this code in VBA:
If Application.CountIf(.Rows(Lrow), '8000')= 0 And Application.CountIf(.Rows(Lrow), '9000')) = 0 Then .Rows(Lrow).Delete
Which is capable for me to delete any row WITHOUT words 8000 and 9000.
However, since there would be future update, how can i adjust the code so that the value for excel to execute can be "DYNAMIC" (i.e. not hard-cored)
Say, if i enter a number at cell (17,2) in SHEET 1, what can i make excel to look at the cell address instead of the "absolute value" from SHEET 2 by VBA?
Thanks.
You could add these couple of lines above the code you already have. This is assuming that you want to change either number by entering them into cell B17 or B18.
Dim lowerBound as Long, upperBound as Long
lowerBound = Sheet1.Range("B17").Value
upperBound = Sheet1.Range("B18").Value
Then replace '8000' in with lowerBound and '9000' with upperBound.
You can add a column X to your source sheet, headed "Condx for DELETE" and fill this column with a formula representing the DELETE condition as a Boolean value - like in your case: =NOT(OR(A2=8000,A2=9000)) (asuming values 8000, 9000, etc. appear in column A)
Then you cycle thru the source table and delete all records for which column X is TRUE. Asuming that
your source has been defined within VBA as a range object (MyRange)
the first row is the header row
no empty cells in first column between header and end of list
the condition is found in 3rd column
a purger could look like this
Sub MySub()
Dim MyRange As Range, Idx As Integer, MyCondx As Integer
Set MyRange = ActiveSheet.[A1] ' represent source data as a range
Idx = 2 ' asuming one header row
MyCondx = 3 ' asuming condition is in 3rd column
Do While MyRange(Idx, 1) <> ""
If MyRange(Idx, MyCondx) Then
MyRange(Idx, 3).EntireRow.Delete
Else
Idx = Idx + 1
End If
Loop
End Sub
This way you have full transparency, no hardcoding and you are very flexible to not only change a set of 2 values but specify whatever condition serves the business.
Hope that helps - good luck