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
Related
I would like to have a subroutine that is passed a named range and a number of rows, and copies that number of rows from the bottom of the range and inserts them into the named range at the bottom, becoming the new bottom of the named range. If I have a range named 'WellC1', depicted here:
I would like the function to copy the bottom n rows (in this case, 12) and paste them (or insert them) at the bottom, while keeping them within the named range, so it ends up like this:
It should only paste the formulas (which is what is shown here as the 11.47 and numbers on the right are formula results) and needs to copy within the named range so the process can be repeated.
Im new to VBA and having severa problems with this. One is insert adds things above the insert point; to keep the new years' data in the named range I figured I could add the first row of the next well's data to the bottom of the range and insert there (so top row of Well C2 is actually the bottom row of Well C1s named range and inserting at it keeps the new Well C1 data in the well C1 range). I can get the insert-into-named-range thing to work fine if there's no merged cells, btw.
The other is I can't figure out how to actually copy the 12 (or n) bottom rows of named range WellC1, because of the merged cells. Is there a way to copy the bottom n rows of a range and/or reference them even if some are merged? What I've been trying so far is tweaking out versions of this:
Sub Copy_Insert_Into_Named_Range( _
target_range As Range, _
Optional num_rows As Integer = 1)
'This uses the top row of the next well range as the bottom of this named range to be able to use a copy/insert and keep it within the named range.
Dim last_row As Range: Set last_row = target_range.Rows((target_range.Rows.Count) - 1)
Dim top_row As Range: Set top_row = target_range.Rows((target_range.Rows.Count) - (num_rows + 1))
Dim num_targ_columns As Integer: num_targ_columns = target_range.Columns.Count
Dim upper_cell As Range: Set upper_cell = top_row.Cells(1)
Dim lower_cell As Range: Set lower_cell = last_row.Cells(num_targ_columns)
Dim copy_area As Range: Set copy_area = Range(upper_cell & ":" & lower_cell)
copy_area.Copy
last_row.Offset(1).PasteSpecial
I'm falling apart at the copy_area set, I think because of the merged cell being lower_cell. Is there a different way to select these 12 (or n) bottom rows of the named range? There's about 600 of these wells we do this to manually per project so I'd like to automate that. My core idea is have each well's area be a named range and step through each named range and run the copy/insert function for it. Its working in other projects that don't have merged cells. I appreciate any ideas!
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).
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.
I must be having a brain fog at this point because I am certain this is easy to do, and in fact I have managed to create other functions that are a bit more complicated for this project.
Anyway, what I am trying to do. I have a sheet (inventory-data) and in column 1, it lists a company name, which is a same for all the rows. i.e. each of the 1900 or so rows have companyname in the first cell.
Now, while the data will always be the same at each application, the number of rows will change.
So, I need a function that will first determine what the last row of data is in the range, and then change all of the cells in column one of each record to name_company. The company names will always be the same so I can staticly assign them. Here is what I have that does not work.
I was able to get it to work another way, but it would replace text all the way down to the very last row of the worksheet, way beyond where the data stops.
Thanks!
Sub changeCompany() 'Changes company name as pulled from Agemni into proper ETA format
Dim myCell As Range
Dim RngToChange As Range 'The range of cells that need to be changed
Dim LastRow As Long 'Declare variable to help determine the last row on a variable length worksheet
Dim i As Integer
With Worksheets("inventory-data") 'set the range to change
Set RngToChange = .Columns(1)
End With
LastRow = Worksheets("inventory-data").UsedRange.Rows.Count 'Have Excel determine what the last row is.
For i = LastRow To 1 Step -1
RngToChange.Cells.Value = "name_company"
Next i
End Sub
I've always had more success with [SomeCellOrRange].CurrentRegion.Rows.Count e.g:
Range("A1").CurrentRegion.Rows.Count
UsedRange looks for any use of cells, not limited to a continuous tabular block. It also sometimes needs you to re-save the workbook before it will properly shrink after you have eliminated some rows.