I have a problem that formulas are not recalculated if I add them in one step from a string field.
My point is to add various complex formula calculations in one step to multiple columns.
None of this works:
automatically calculated formulas are switched on
I've tried
ActiveCell.NumberFormat = "General" - doesnt work
I've tried
Application.Volatile - doesnt work Recording text to columns and
assign cells to "general"
Sub AddActualsSum2()
Dim ws As Excel.Worksheet
Set ws = ThisWorkbook.Worksheets("XXXX")
Call ProtectSheet(ws, False)
Dim r, s, monthRange, monthRange01, monthRangeDynamic As Range
Dim MonthLock, i, LockActuals As Integer
Dim c As String
Dim StartActualsDate, PlanDate As Date
Set monthRange = Range("_ActualsY02M01:_ActualsY02M12")
Set monthRangeDynamic = Range("_ActualsSumMonthY2")
Dim varData(1 To 12) As String
Call ProtectSheet(ws, False)
For i = 1 To 12
varData(i) = "=1+2"
Next
Debug.Print "Format: " & monthRange(1).NumberFormat
Debug.Print "Value: " & monthRange(1).Value
Debug.Print "Formula: " & monthRange(1).Formula
monthRange.Formula = varData
End Sub
The result is that the formula = 1 + 2 is everywhere
after clicking in the formula line, the formula is already calculated correctly.
When writing the array as a block, Excel treats the values are strings (which they are), rather than formulae.
Put the formula writing inside the loop, like
For i = 1 To 12
varData(i) = "=1+2"
monthRange.Cells(i, 1).Formula = varData(i)
Next
Also, your variable declarations are wrong. VBA requires each variable to have a type, otherwise they are Variants by default. For example:
Dim MonthLock, i, LockActuals As Integer
Should be:
Dim MonthLock As Range, i As Integer, LockActuals As Integer
Related
I am trying to copy a formula from another sheet ("SCE_Tables") to a central sheet ("Main"). "SCE_Tables" holds reference tables that I am copying over to main, based on selections from a form that the user fills out.
The formula in "SCE_Tables", uses RC-notation to subtract values from columns 2 to the left ('Prebill'), and 1 to the left ('Post BESS Bill') of the cells in the 'BESS Savings' column:
In the highlighted cell below:
Formula:
=RC[-2]-RC[-1]
. This cell is at Row 15, Column 6
The issue arises when I try to fill the "Main" sheet range with these tables. The "Main" sheet range where these tables go have the same format as the reference tables:
The highlighted cell below (on the "Main" sheet), is at Row 21, Column 18. The formula in this cell is:
Formula:
=R[-6]C[-14]-R[-6]C[-13]
The RC reference that is copied over to the "Main" sheet converts the RC reference back to that in the "SCE_Tables" sheet, resulting in the formula trying to calculate:
(R15, C4) - (R15, C5)
on the main sheet, when my desired formula is:
(R21, C16) - (R21, C15)
Is there a way I dynamically create a formula that calculates the difference between the cells 2 to the left and 1 to the left of the cell in the "Main" sheet?
Edit: Including some of my VBA code
To process the ListBox selections:
Public Sub FormatListboxSelections(ByVal selectionNameArray As Variant)
testInt = 0
'Entire possible area for tables
Dim tableRange As Range
Set tableRange = Range("TableRange")
Dim SDR As Range
Set SDR = Range("ScenarioDetailsRange")
'Electricity Provider
Dim i As Integer, elecProvider As String
elecProvider = Range("input_electricity_provider").Value
'Clear range
tableRange.ClearContents
SDR.ClearContents
Dim currRow As Integer, leftCol As Integer, startingCell As Range
currRow = 1
'Loop through all selections
For i = LBound(selectionNameArray) To UBound(selectionNameArray)
Dim selectionTableObj As Variant
Dim scenario As String
scenario = selectionNameArray(i)
'If arr(i) == 0, we've reached end of the selected values
If Len(scenario) = 0 Then
Debug.Print "Exiting loop at index " & i
Exit For
Else
'Check for each scenario type
'PV only scenario
If scenario = "PV Only" Then
Set selectionTableObj = HandlePVOnly(electricityProvider:=elecProvider, scenario:=scenario)
ElseIf scenario = "2hr Only" Or scenario = "4hr Only" Then
Set selectionTableObj = HandleBESSOnly(electricityProvider:=elecProvider, scenario:=scenario)
Else
Set selectionTableObj = HandleComboScenario(electricityProvider:=elecProvider, scenario:=scenario)
End If
selectionTableObj.UpdateAllFields
testInt = testInt + 1
End If
Dim x As Integer
'Iterate through all rows in the selected table
For x = 1 To selectionTableObj.m_table.Rows.Count
Dim dummy As Variant
Set dummy = Application.WorksheetFunction.Index(selectionTableObj.m_table.Rows, x, 0)
Dim selectionTableRow As Variant
Set selectionTableRow = selectionTableObj.m_table.Rows(x)
'Update single row
'***HERE IS WHERE THE SELECTED TABLES GET WRITTEN TO THE MAIN
'WORKSHEET***
Dim j As Integer
For j = 1 To dummy.Columns.Count
tableRange(currRow, j).Formula = dummy(1, j).Formula
Next j
'increment currRow
currRow = currRow + 1
Next x
Next
'If full selection, also show respective extra inputs
If UBound(selectionNameArray) = 7 Then
PopulateExtraInputs elecProvider
End If
End Sub
To handle BESS scenarios (one of 3 scenario types the user can select with the form), I use a Factory module and call the 'InitiateProperties' subroutine in the BESSScenarioTable class module:
Public Function CreateBESSScenarioTable(ByVal table As Range, scenario As String, scenarioDetailsArray As Variant, tableLength As Integer, ByVal result As ScenarioResult, tariffs As Variant)
Set CreateBESSScenarioTable = New BESSScenarioTable
CreateBESSScenarioTable.InitiateProperties table:=table, scenario:=scenario, scenarioDetailsArray:=scenarioDetailsArray, tableLength:=tableLength, result:=result, tariffs:=tariffs
End Function
'Constructor
Public Sub InitiateProperties(table As Range, scenario As String, scenarioDetailsArray As Variant, tableLength As Integer, result As ScenarioResult, tariffs As Variant)
Set m_table = table
'Using Formula instead of Value to capture column relationships in "Source of Truth" tables (PGE_Tables, SDGE_Tables, SCE_Tables worksheets)
Debug.Print "Address: " & m_table.address
Dim xc As Integer, yc As Integer
For xc = 1 To m_table.Rows.Count
For yc = 1 To m_table.Columns.Count
Debug.Print "(" & xc & ", " & yc & ") - Formula: " & m_table.Cells(xc, yc).Formula
Next yc
Next xc
m_table.FormulaR1C1 = table.FormulaR1C1
m_scenario = scenario
m_scenarioDetailsArray = scenarioDetailsArray
m_tableLength = tableLength
Set m_result = result
m_tariffs = tariffs
End Sub
Figured it out - turns out in my VBA code where I was copying the table over, I needed to use tableRange(currRow, j).FormulaR1C1 = dummy(1, j).FormulaR1C1, instead of what I had before: tableRange(currRow, j).Formula = dummy(1, j).Formula
This link was helpful in learning about the different notations Excel uses: https://powerspreadsheets.com/r1c1-formular1c1-vba/
I'm trying to make a unique ID for each sample in a variable length data set. to do this I want to use part of two strings of data called the Name and Sample Type. I want i to go down each row in the column and take the pieces of each string and put them together, however when I step through the loop it never goes into my loop, only around it. can someone tell me why?
Sheets("Data").Activate
setlastrow = Sheets("Data").Range("b5000").End(xlUp).Row
setlastcol = Sheets("Data").Cells(5, Columns.Count).End(xlToLeft).Column 'this is still assuming that row 5 has the header in it
colname = Rows(5).Find("Name", LookAt:=xlWhole).Column ' this can be repeated for any other columns we want to asign values to. These variables will make the rest of this much easier
colSampleText = Rows(5).Find("Sample Text", LookAt:=xlWhole).Column
For i = 6 To lastrow
Sheets("Data").Range(Cells(i, 1)) = workbookfunction.if(workbookfunction.CountIf(Range(Cells(6, colname), Cells(i, colname)), Cells(i, colname)) < 10, "0", "") & workbookfunction.CountIf(Range(Cells(6, colname), Cells(i, colname)), Cells(i, colname) & "-" & Left(Cells(i, colSampleText), 5))
'this should find the unique identifying infomation for each sample and analyte
Next i
There are two major errors in your code - plus a minor one. One is structural. You declare non of the variables you use. It's like saying, "Since I don't know how to drive I might as well close my eyes as we speed along". It's not without logic but does little toward getting you to where you want to go.
The other is in the mix-up between the worksheet function you want VBA to execute and the one you wish to assign to a cell to be executed by Excel. Writing a complex formula to a cell is more difficult than getting VBA to calculate a complex formula. For the method, if you want to create a formula in VBA you should assign it to a string first, like MyFormula = "=COUNTIF(D6:D12, "MyName")" and then, after testing it, assign that string to the cell's Formula property, like Cells(R, ClmName).Formula = MyFormula". In the code below I chose to let VBA do the calculating. Since it isn't entirely clear what you want (faulty code is never a good way to show what you intend!) please revise it. It's easier in VBA than in a worksheet function.
Private Sub Test()
Dim LastRow As Long
Dim LastClm As Long
Dim ClmName As Long ' R use "col" for color, "clm" for column
Dim ClmSampleText As Long
Dim CountRng As Range
Dim Output As Variant
Dim R As Long ' R use R for row, C for column
Sheets("Data").Activate
LastRow = Sheets("Data").Range("b5000").End(xlUp).Row
' this is still assuming that row 5 has the header in it
LastClm = Sheets("Data").Cells(5, Columns.Count).End(xlToLeft).Column
' this can be repeated for any other columns we want to asign values to.
' These variables will make the rest of this much easier
ClmName = Rows(5).Find("Name", LookAt:=xlWhole).Column
ClmSampleText = Rows(5).Find("Sample Text", LookAt:=xlWhole).Column
For R = 6 To LastRow
'this should find the unique identifying infomation for each sample and analyte
Set CountRng = Range(Cells(6, ClmName), Cells(R, ClmName))
Output = WorksheetFunction.CountIf(CountRng, Cells(R, ClmName).Value)
If Output < 10 Then Output = 0
Cells(R, 1).Value = CStr(Output) & "-" & Left(Cells(R, ClmSampleText).Value, 5)
Next R
End Sub
The "minor" mistake stems from your lack of understanding of the Cell object. A cell is a Range. It has many properties, like Cell.Row and Cell.Column or Cell.Address, and other properties like Cell.Value or Cell.Formula. The Value property is the default. Therefore Cell is the same as Cell.Value BUT not always. In this example, by not thinking of Cell.Value you also overlooked Cell.Formula, and by placing Cell into a WorksheetFunction you confused VBA as to what you meant, Cell the Value or Cell the Range. With all participants confused the outcome was predictable.
The recommendation is to always write Cell.Value when you mean the cell's value and use Cell alone only if you mean the range.
You have an error with the end part of your For...Next statement.
From the code you have posted, LastRow is not explicitly declared anywhere, so when you run your code, LastRow is created as Type Variant with a default Empty value.
Consider this code:
Sub LoopTest()
Dim DeclaredVariable As Long
Dim i As Long
DeclaredVariable = 10
For i = 1 To UnDeclaredVariable
Debug.Print i & " UnDeclaredVariable"
Next i
For i = 1 To DeclaredVariable
Debug.Print i & " DeclaredVariable"
Next i
End Sub
The output in the immidiate window would be:
1 DeclaredVariable
2 DeclaredVariable
3 DeclaredVariable
4 DeclaredVariable
5 DeclaredVariable
6 DeclaredVariable
7 DeclaredVariable
8 DeclaredVariable
9 DeclaredVariable
10 DeclaredVariable
This shows us that the loop for the UnDeclaredVariable has not been entered - AND this is due to the fact the end part of the For...Next loop is Empty (The default value of a Variant data type) so there is no defined end for the loop to iterate to.
NB To be more precise, the issue is that the UnDeclaredVariable has no (numeric) value assigned to it - if you assign a value to a variable that is undeclared it becomes a data type Variant/<Type of data you assigned to it> for example UnDeclaredVariable = 10 makes it a Variant/Intigertype .
The reason why it steps over the loop and doesn't throw an error is because you don't have Option Explicit at the top of your code module (or Tools > Options > "Require Variable Declaration" checked) which means the code can still run with undeclared variables (this includes if you spell a declared variable incorrectly).
If you add Option Explicit to the top of your code module:
Option Explicit
Sub LoopTest()
Dim DeclaredVariable As Long
Dim i As Long
DeclaredVariable = 10
For i = 1 To UnDeclaredVariable
Debug.Print i & " UnDeclaredVariable"
Next i
For i = 1 To DeclaredVariable
Debug.Print i & " DeclaredVariable"
Next i
End Sub
You would get the following error:
Compile Error:
Variable not defined
This is a fantastic example of why Option Explicit is an important declaration to make in all code modules.
Here is a variation of your code; I've modified your code to set your two columns using Find, loop through each cel in the range(using the current row), set varcnt to count the number of matches, defined the first 5 letters of value in the Sample Text column as str, and used a basic If statement to write the combined the unique ID into the first column.
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Data")
Dim lRow As Long: lRow = ws.Range("b5000").End(xlUp).Row
Dim dataCol As Long: dataCol = ws.Range("A5:J5").Find(What:="Name", LookIn:=xlValues, lookat:=xlWhole).Column
Dim smplTextCol As Long: smplTextCol = ws.Range("A5:J5").Find(What:="Sample Text", LookIn:=xlValues, lookat:=xlWhole).Column
For Each cel In ws.Range(ws.Cells(6, dataCol), ws.Cells(lRow, dataCol))
Dim varcnt As Long: varcnt = Application.WorksheetFunction.CountIf(ws.Range(ws.Cells(6, dataCol), ws.Cells(cel.Row, dataCol)), ws.Cells(cel.Row, dataCol).Value)
Dim str As String: str = Left(ws.Cells(cel.Row, smplTextCol).Value, 5)
If varcnt < "4" Then
ws.Cells(cel.Row, 1).Value = "0" & "-" & str
Else
ws.Cells(cel.Row, 1).Value = "" & "-" & str
End If
Next cel
Put the code I'm working with at the bottom.
I am trying to enter a set of formulas in a range with code. The formulas enter correctly, but they only calculate if I click on each cell, click on the formula box, and hit enter.
I've tried all suggestions I can find online, hence the last three lines of code. It's not a matter of the cells changing format, they remain General after the code runs. I'm completely stumped.
Sub ButtonTest()
Dim Number As Integer
Number = Range("M2").Value
Dim TestArray() As String
ReDim TestArray(0, 1 To Number)
Dim Values As Integer
Dim RangeValues As Integer
Dim Variable As Integer
Variable = 3
TestArray(0, 1) = "=1"
For Values = 2 To Number
TestArray(0, Values) = "=" & Cells(3, Variable).Address & "+1"
Variable = Variable + 1
Next Values
Range("C3:" & Cells(3, Number + 2).Address).Formula = TestArray
Application.Calculation = xlCalculationAutomatic
ActiveSheet.EnableCalculation = True
ActiveSheet.Calculate
End Sub
To enter a formula from an array use .FormulaArray rather than .Formula
Range("C3:" & Cells(3, Number + 2).Address).FormulaArray = TestArray
Not sure if I'm off the mark here, but I always had the impression that formulas couldn't be written to a Range in an array (as you would with values, for example). I believe you have to write one cell at a time.
There may be a method that can be called to convert array values to evaluated cells, but I don't know of it - be happy to hear if anyone can enlighten me though.
In the meantime, the code below gives an example of how your code could be made to work:
Dim iterationCount As Long, i As Long
Dim cell As Range
iterationCount = Sheet1.Range("M2").Value
Set cell = Sheet1.Range("C3")
cell.Formula = "=1"
For i = 1 To iterationCount
cell.Offset(, 1).Formula = "=" & cell.Address & " + 1"
Set cell = cell.Offset(, 1)
Next
I'm currently working on a project on VBA that requires multiple manipulation on data.
So, the main idea of this will be to get the data that I have on "Q1" and paste it 4 times on A (starting at the first blank cell), after that, take the data from "Q2" and do the same until there is no more data on the "Q" column. After there is no more data, the process should stop.
Later on I may need to modify the process, so the value gets pasted only 2 or 3 times instead of 4.
Something like this:
Column Q data:
Expected result:
I think this will do what you want:
Option Explicit
Sub Transpose_Multiplied()
Dim Number_Of_Repetitions As Integer
Dim Input_Column As String
Dim Output_Column As String
' -----------------------------------------------------------
' These are the control variables ....
Number_Of_Repetitions = 4
Input_Column = "Q"
Output_Column = "A"
' -----------------------------------------------------------
Dim WSht As Worksheet
Dim Cell As Range
Dim LastACell As Long
Dim i As Integer
Set WSht = ActiveWorkbook.ActiveSheet
For Each Cell In WSht.Range(Input_Column & "2:" & Input_Column & WSht.Cells(WSht.Rows.Count, Input_Column).End(xlUp).Row)
For i = 1 To Number_Of_Repetitions
LastACell = WSht.Cells(WSht.Rows.Count, Output_Column).End(xlUp).Row
If LastACell = 1 And WSht.Cells(LastACell, Output_Column).Value = vbNullString Then
WSht.Cells(LastACell, Output_Column).Value = Cell.Value
Else
WSht.Cells(LastACell + 1, Output_Column).Value = Cell.Value
End If
Next
Next
End Sub
So, I open up my workbook and leave it open on the Worksheet where the data to be processed is. Then I run the macro from my PERSONAL.XLSB:
I am trying to get the earliest start date (min) and the furthest end date (max) based on criteria in a source column. I have created several functions based on a solution I found on the internet. I have also tried an array formula solution without using VBA. Neither of the approaches have worked. I have found similar questions/answers on SO but none that correctly apply to my situation.
In my example below I have a Task worksheet and an Export worksheet. The Export worksheet is the source data. In the Task worksheet I am trying to enter a formula that finds the minimum start date. Each Task ID can have several dates so I am trying to find the lowest and highest start dates for each of the tasks. I originally tried using an array formula but ran into the same problem which is that sometimes the formula produces the correct answer and sometimes it gives an incorrect answer and I cannot locate the source of the issue. Any help is much appreciated!
VBA Functions:
Function getmaxvalue(Maximum_range As Range)
Dim i As Double
For Each cell In Maximum_range
If cell.Value > i Then
i = cell.Value
End If
Next
getmaxvalue = i
End Function
Function getminvalue(Minimum_range As Range)
Dim i As Double
i = getmaxvalue(Minimum_range)
For Each cell In Minimum_range
If cell.Value < i Then
i = cell.Value
End If
Next
getminvalue = i
End Function
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim Position As Double
Position = 1
Dim getminvalue As Double
getminvalue = MinRange.Rows(1).Value
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MinRange.Rows(Position).Value < getminvalue Then
getminvalue = MinRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMinIf = getminvalue
End Function
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim Position As Double
Position = 1
Dim getmaxvalue As Double
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MaxRange.Rows(Position).Value > getmaxvalue Then
getmaxvalue = MaxRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMaxIf = getmaxvalue
End Function
The issue is that you are trying to equate positions incorrectly. Use this for the MinIf, it no longer needs the secondary function:
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MinRange.Parent.UsedRange, MinRange).Value
Dim minTemp As Double
minTemp = 9999999999#
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) < minTemp Then
minTemp = mrarr(i, 1)
End If
Next i
GetMinIf = minTemp
End Function
Max:
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MaxRange.Parent.UsedRange, MaxRange).Value
Dim maxTemp As Double
maxTemp = 0
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) > maxTemp Then
maxTemp = mrarr(i, 1)
End If
Next i
GetMaxIf = maxTemp
End Function
As far as formula go IF you have OFFICE 365 then use MINIFS
=MINIFS(Export!F:F,Export!A:A,A2)
=MAXIFS(Export!G:G,Export!A:A,A2)
If not use AGGREGATE:
=AGGREGATE(15,7,Export!$F$2:F$26/(Export!$A$2:A$26=A2),1)
=AGGREGATE(14,7,Export!$G$2:G$26/(Export!$A$2:A$26=A2),1)
I was trying to use Scott's method as part of a macro to transform an invoice. However, the rows of the invoice fluctuate every month and could grow to as many as a million in the future. Anyway, the bottomline is that I had to write the formula in a way where I could make the last row dynamic, which made the macro go from taking 10-15 minutes (by hardcoding a static last row like 1048576 to run to ~ 1 minute to run. I reference this thread to get the idea for the MINIFS workaround and another thread to figure out how to do a dynamic last row. Make vba excel function dynamic with the reference cells
I'm sure there are other methods, perhaps using offset, etc. but I tried other methods and this one was pretty quick. Anyone can use this VBA formula if they do the following:
15 to 14 to do a maxifs, keep as is for minifs
change the relevant rows and columns in Cells(rows, columns) format below.
The True/False parameters passed to .Address() will lock/unlock the rows/columns respectively (i.e. add a $ in front if True).
Change the last row
First, get the last row
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Second, here is the dynamic minifs
Range("F2").Formula = "=AGGREGATE(15,7," & Range(Cells(2, 6), Cells(LastRow, 6)).Address(True, True) & "/(" & Range(Cells(2, 1), Cells(LastRow, 1)).Address(True, True) & "=" & Range(Cells(2, 1), Cells(2, 1)).Address(False, True) & "),1)"
Third, autofill down.
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)