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
Related
I wrote a function which will concatenate all the cells to the left of the cell the function is in, using a delimiter. My code is:
Public Function Concat_To_Left(delim As String)
Dim C, R As Long
Dim S As String
Dim Cell As Range
Set Cell = ActiveCell
C = Cell.Column
R = Cell.Row
S = Cells(R, 1).Value
For i = 2 To (C - 1)
S = S & delim & Cells(R, i).Value
Next i
Concat_To_Left = S
End Function
This code works if calculating a single row. The problem I'm running into is that the cell.row and cell.column seem to be saved from the first cell when I fill the function to the bottom of a column (by double clicking the bottom right of the cell in the excel sheet). This results in all cells with this function having the same value as the cell being filled down from.
Screen-Updating, Events, and Alerts are all on/true. Application.Calculation is set to xlCalculationAutomatic
Can anyone tell me how to make this function work on each cell the formula is filled down into, using the proper row and column for each cell (not that column matters when filling down)?
Scott's comment about using TEXT join worked as a workaround to what I was trying to accomplish.
=TEXTJOIN(", ",TRUE,B2:INDEX(2:2,COLUMN()-1))
The link he provided to the custom code for TEXTJOIN was very nice as well:
MS Excel - Concat with a delimiter
Adding Application.Volatile did not make my function work. I did not find a way to get my function working with fill down without needing a range parameter, so TEXTJOIN is the next best option and answers my question for now.
EDIT:
I wrote this macro to work instead of a function:
Private Sub Concat_To_Left()
Dim C, R, LR As Long
Dim Cell As Range
LR = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
C = ActiveCell.Column
R = ActiveCell.Row
For Each Cell In ActiveWorkbook.ActiveSheet.Range(Cells(R, C), Cells(LR, C))
Cell.Value = Cells(Cell.Row, 1).Value
For i = 2 To (C - 1)
Cell.Value = Cell.Value & "|" & Cells(Cell.Row, i).Value
Next i
Next Cell
End Sub
This one uses "|" as a delimiter, fills down from the active cell to lastrow concatenating every cell to the left, including blanks.
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
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
Given the Image... If I know that there is some data starting at Range("B3").
How can I find the cells with contiguous data that is till cell E3? Since F3 is blank G3 onwards should not be considered.
The result could either be a range object (B3:E3) or count of cells( 4 in this case).
By setting B3 as the Active cell and doing..
Range(ActiveCell, ActiveCell.End(xlToRight).Count
I do get the count, however this method is not reliable, in case only B3 has data it counts the cells till the end of the sheet.
Of course this could also be achieved by looping through the cells but I'd rather use a Worksheet Function or some other efficient method.
It seems that you are trying to determine the number of continuous columns used by in a row, starting from cell B3.
The code below will return the values of $B$3:$E$3 and 4 based on your data. If only cell B3 has data, it will return $B$3 and 1.
Sub GetDataArea()
Dim strCellToTest As String
Dim rngMyRange As Range
Dim lngColumns As Long
strCellToTest = "B3"
lngColumns = ActiveWorkbook.ActiveSheet.Range("" & strCellToTest).End(xlToRight).Column - 1
If lngColumns >= 256 Then
Set rngMyRange = ActiveWorkbook.ActiveSheet.Range("" & strCellToTest)
lngColumns = 1
Else
Set rngMyRange = ActiveWorkbook.ActiveSheet.Range _
(strCellToTest & ":" & Range("" & strCellToTest).Offset(0, lngColumns - 1).Address)
End If
MsgBox "Columns: " & lngColumns & vbCr & vbLf & "Range: " & rngMyRange.Address
End Sub
Intersect(Activecell.CurrentRegion, ActiveCell.EntireRow)
Will return B3:E3. Alternatively
If IsEmpty(ActiveCell.Offset(0,1).Value) Then
Set rMyRange = ActiveCell
Else
Set rMyRange = ActiveCell.Parent.Range(ActiveCell, ActiveCell.End(xlToRight))
End If
rMyRange will also return B3:E3
You could use the CurrentRegion property. This returns the range that is contiguous to the specified range. So...
Range("B3").CurrentRegion returns the range B3:E3
Range("B3").CurrentRegion.Columns.Count returns 4
Range("B3").CurrentRegion.Cells.Count also returns 4
However, if you had data in rows 4 and below (let's say you had data in B4:E6), then you would get these results
Range("B3").CurrentRegion returns the range B3:E6
Range("B3").CurrentRegion.Columns.Count returns 4
Range("B3").CurrentRegion.Cells.Count returns 16
Is this what you were after?
I like to use a function that counts columns that contain values until it encounters an empty cell. The return value can be used to set up a FOR NEXT loop to churn through a table. Here is how I would do it:
Sub tester()
Dim Answer
Answer = CountColumns(3, 2)
MsgBox "There are " & Answer & " columns."
End Sub
Public Function CountColumns(ByVal startRow As Integer, ByVal startColumn As Integer)
'Pass starting location in spreadsheet for function to loop through until
'empty cell is found. Return count of columns function loops through
Do While ActiveSheet.Cells(startRow, startColumn).Value <> ""
startColumn = startColumn + 1
Loop
startColumn = startColumn - 1
CountColumns = startColumn
End Function
Depending on how general you need to get, it could be as simple as
Application.WorksheetFunction.Count([b4:e4])
If you want to tie in the ActiveCell, try
Application.WorksheetFunction.Count(intersect(activecell.CurrentRegion, activecell.EntireRow))
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)