I'm trying myself on vba with little success. I would like to achieve a simple function that sums the content of a range of cells based on the beginning of the year till today. Unfortunately, I get back a "circular reference" error when I call the function, and I just can't see why. Any help will be appreciated.
Public Function til2day(r As Integer) As Long ''supposed to receive cell("row") as parameter
Dim c As Integer
Dim c1 As Integer
Dim c_here As Integer
Application.Volatile True
c_here = ActiveCell.Column
c = 0
c1 = 34 ''column contains 1/1/2013 date
Range("AH4:OM4").Activate ''contains a timeline
Do While ActiveCell.Offset(0, c).Value <> Date
c = c + 1
Loop
If ActiveCell.Offset(0, c).Value = Date Then
c = ActiveCell.Offset(0, c).Column
End If
til2day = Application.WorksheetFunction.Sum(Range(Cells(r, c1).Address, Cells(r, c).Address))
Range(Cells(r, c_here).Address).Activate
End Function
It is a really bad idea to use "activate" in a function; I can't explain exactly why this is, except that you are changing the selection of the cell during the calculation. In the following scenario this is going to cause a problem:
multiple cells are being calculated with this function, and
you use `Application.Volatile`, and
you refer to the active cell inside your function, and
you allow multi-threaded calculation,
Things will not happen in the order you expect, and at some point the active cell will be different than you thought. Function ends up referring to the cell it's in, and you have a circular reference. This doesn't happen when you run the debugger since it by definition runs as a single thread - which is why you can't find the problem then...
Here is a suggested rewrite of your function - it doesn't do any activating of cells, but attempts to maintain the same functionality:
Public Function til2day(r As Integer) As Long ''supposed to receive cell("row") as parameter
Dim c As Integer
Dim c1 As Integer
Dim dateRange as Range
Dime dateCell as Range
Application.Volatile True
c = 0
c1 = 34 ''column contains 1/1/2013 date
set dateRange = Range("AH4:OM4")
For Each dateCell in dateRange
If dateCell.Value = Date Then Exit For
Next dateCell
c = dateCell.Column
til2day = Application.WorksheetFunction.Sum(Range(Cells(r, c1).Address, Cells(r, c).Address))
End Function
Note: I attempted to reproduce the functionality of your function - but without a good example of the worksheet you are using, and the values you are expecting to return, it's hard to test. Please try to run this on your worksheet - and let me know if things don't work as you expected.
Note also that the SUMIF function could be used with good effect:
=SUMIF(range, criteria, sum_range)
In your case, use
=SUMIF($AH$4:$OM$4, "<=" & NOW(), $AH18:$OM18)
Where "18" is whatever row you need it to be (and when you drag the formula to a different row, it will continue to refer to the date row because of the $4 absolute reference, but calculate the sum for a different row because of the relative row reference in $AH18:$OM18.
An example of the use of this function (simplified range...)
As you can see, the function is summing columns C through F only since I did this on June 15th.
Related
I need to find the value not equal 1 in the column A and get all the position in the same field.
I want to get the all not equal 1 position into the B11.
I want to use the excel formula function and don't use vba or other code. How can I do ? Is possible ?
Since you are working with Excel-2007, unfortunately you won't be able to use the new TEXTJOIN() and CONCAT() functions (nor power query). However you can get quite creative with a function like CONCATENATE(), it will most likely mean at some point you'll have to do some manual 'labour'. Who wants to do manual labour? ;)
So in this case I would prefer to go the UDF way. Below a tested example:
Function GetPos(RNG As Range, VAL As Double) As String
Dim CL As Range, ARR() As String, X as double
X = 1
For Each CL In RNG
If CL.Value <> VAL Then
ReDim Preserve ARR(X)
ARR(X) = CL.Address(False, False)
X = X + 1
End If
Next CL
If IsEmpty(ARR) Then
GetPos = "No hits"
Else
GetPos = Join(ARR, ",")
GetPos = Right(GetPos, Len(GetPos) - 1)
End If
End Function
This one takes two criteria, a range and a numeric value indicating what the cells in your range must NOT be. It will return a string value.
Call it from your worksheet through =GETPOS(A1:A10,1) and it should return A2,A7,A9
EDIT
If you are fine using a helper column you could do it like so:
Formula in B1:
=IF(A1<>1,"A"&ROW()&",","")
Formula in B11:
=LEFT(B1&B2&B3&B4&B5&B6&B7&B8&B9&B10,SUM(LEN(B1:B10))-1)
Enter through CtrlShiftEnter
Note: If you don't want to use a helper column you'll have to use TRANSPOSE() to 'load' an array of text values but it involves manual labour and IMO you'll surpass your goal.
I am new to coding and have written some code to do some calculations within a table and fill in columns. I have it working for the first row within the table but I am having some trouble figuring out how to loop it so that it completes the calculations for every row within the table. Any help and advice would be greatly appreciated!
UPDATE:
Thanks for the Help! The code works perfectly for the first part provided here, I have tried to apply this to the other 2 parts, but am coming up with an error. I think due to the fact that I am trying to use a string as the input? I have tried without the quotation marks but all it returns is "#NAME?".
Sub CommandButton1_Click()
Dim tbl As ListObject
Set tbl = ThisWorkbook.Sheets("Data").ListObjects("Table1")
Dim formulaText As String
formulaText =
"=IF([#Reach]>=100000,5,IF([#Reach]>=50000,3,IF([#Reach]>=10000,2,1)))"
tbl.ListColumns("Media Significance").DataBodyRange.Formula = formulaText
Dim formulaText1 As String
formulaText1 = "=IF([#Headline Mentions]>="Yes",5,IF([#Exclusive
Mentions]>="Yes",3,1))"
tbl.ListColumns("Prominence Score").DataBodyRange.Formula = formulaText1
Dim formulaText2 As String
formulaText2 = "=IF([#Sentiment]>="Very Positive",2,IF([#Sentiment]>="Very
Negative",2,1))"
tbl.ListColumns("Very Positive/ Very Negative").DataBodyRange.Formula =
formulaText2
End Sub
Looping through each cell in a range is very slow, so you're either going to want to either load your data into an array first, or use a regular Excel formula + the FillDown function.
In this particular case, I'd recommend the second option, which will allow you to add your formula to a single cell and fill it down the rest of the column. Something like this should work:
Dim colNum As Long
With ThisWorkbook.Sheets("Example Sheet")
'Find last row in sheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Add first formula
colNum = .Range("V2").Column
.Cells(2, colNum).Formula = "=IF(T2>=100000,5,IF(T2>=50000,3,IF(T2>=10000,2,1)))"
.Range(.Cells(2, colNum), .Cells(lastRow, colNum)).FillDown
End With
One problem with your current code is that the column letters are hard-coded. IE, you're expecting to find something called "Reach" in column L, and assuming that this will always be the case. However, if you ever add another column to the left of "Reach", it will break your code.
That's one reason why I'd probably recommend turning your range into a table object with descriptive column names. That should make your code much easier to read and maintain, like this:
Dim tbl As ListObject
Set tbl = ThisWorkbook.Sheets("Example Sheet").ListObjects("YourTable")
Dim formulaText As String
formulaText = "=IF([#Reach]>=100000,5,IF([#Reach]>=50000,3,IF([#Reach]>=10000,2,1)))"
tbl.ListColumns("Reach Analysis").DataBodyRange.Formula = formulaText
For starters, you have redundant criteria in your first If/ElseIf/End If statement.
This,
If Reach >= 100000 Then
Result = 5
ElseIf Reach < 100000 And Reach >= 50000 Then
Result = 3
ElseIf Reach < 50000 And Reach >= 10000 Then
Result = 2
ElseIf Reach < 10000 Then
Result = 1
End If
... can be written more succinctly as,
If Reach >= 100000 Then
Result = 5
ElseIf Reach >= 50000 Then
Result = 3
ElseIf Reach >= 10000 Then
Result = 2
Else
Result = 1
End If
These If/ElseIf/Else/End If conditions are resolved sequentially. Since you won't get into the second criteria unless Reach is less than 100000, there is no need to put that specification into the second criteria. The same logic can be applied for the remainder of the conditions.
Your second If/ElseIf/End If has an error in syntax.
ElseIf Headline = "No" And Exclusive = Yes Then
The Yes here should be quoted or the condition will be looking for a variable named Yes. Putting Option Explicit at the top of the module code sheet in the Declarations area will catch these errors quickly. You can also access the VBE's Tools, Options command and put a checkmark beside Require Variable Declaration and Option Explicit will be automatically put into the Declaration area of each new code sheet you create.
The problem:
There is a range with double values. I would like to get the address of the maximum value.
I tried with the match function, but it can't compare doubles (gives false results), and my range isn't ordered.
There are ugly solutions (for example I can multiply my numbers by 10000, if I want 5 digit precision, then get the integer part and compare that, but it is very slow with more than 20000 rows) and maybe there are more elegant solutions.
Thanks :)
Sample Data: These are the numbers after Debug.Print
B 7.59999999999934E-02
C 7.00000000000074E-02
D 0.335000000000008
E 8.19999999999936E-02
F 8.49999999999937E-02
G 7.39999999999981E-02
H 5.49999999999926E-02
I 0.070999999999998
J 0.165000000000006
K 7.59999999999934E-02
Why not just iterate your range and change a variable if the next cell double value is greater? Once you finish this range use the find to return cell row and column. See below
Dim i as Variant
For Each i In Worksheets("yourWorkSheet").Range(Range("youStartCell"), Range("yourStartCell").End(xlDown)).Cells
If i.Offset(-1) < i Then
i = i.value
End if
Next
Should look something like this. Need to handle the first row case in loop but if i did that you would have no work to do.
This is my final solution:
'Find max and its address in range
Public Function maxAddress(rng As Range) As DoubleLong
Dim cell As Range
For Each cell In rng
If IsNumeric(cell.Value2) Then
If cell.Value2 > maxAddress.db Then
maxAddress.db = cell.Value2
maxAddress.lg = cell.Row
End If
End If
Next cell
End Function
where is defined a type:
Public Type DoubleLong
db As Double
lg As Long
End Type
I'm developing a VBA function for Excel. It will take input parameters of an integer (we'll call it ref_num), and a range. It will search through the range, looking for ref_num as the value of a cell. When it finds ref_num (which may or may not be present), it will go to the second row of the column that ref_num is in, and store that value as a string in the return variable (the value is a date, and 1-31 each have their own column). Every time ref_num is found in a column, the value in the second row will be appended to the return string.
Slightly more concrete example:
ref_num is 2, and 2 occurs in columns A, B, and C. The values in A2, B2, and C2 are 1, 2, and 3, respectively, so the function must return "1, 2, 3".
This is my pseudo-code, but I need some help filling in the blanks...
Note that this currently does not work, and that the algorithm is very much brute force. I just want to get something working.
Function GetDays(ref_num As Integer, range_o_cells As Range) As String
Dim num_dates As Integer
Dim day As String
Set num_dates = 0
'iterate through all the cells and see if the value is ref_num
For Each c In range_o_cells
If c.Value = ref_num Then
'get the cell's column, then reference the second row and get the value. Note that this will be an int that we need to convert to a string
'I seriously doubt the following line will work
day = CStr(Cells(c.Column, 2).Value)
'Once you have the value, append it to the return value
If num_dates = 0 Then
'This is the first value we've found, so we don't need to prepend a comma
GetDays = day
num_dates = 1
Else
'This is probably not valid VBA syntax...
GetDays = GetDays & ", " & day
End If
Next c
End Function
Note that currently, if I call it like this: =GetDays(AG39, $P$3:$W$500) where AG39 is the cell containing ref_num, I get #NUM!
There are multiple issues in your code
You don't use Set for integers
Missing an End If
As you suspected, your indexing into Cells is iffy
You should build your return string into day and assign it to the function in one place
Looping over a range is Slow
You should declare all variables
Better approach is to move the data to a variant array, and loop that. Also include the header data in the range passed to range_o_cells (I'm guessing thats $P$1:$W$500)
Here's your code refactored
Function GetDays( _
ref_num As Long, _
range_o_cells As Range, _
Optional Sep As String = ", ") As String
Dim dat As Variant
Dim rw As Long, col As Long
Dim day As String
dat = range_o_cells.Value
For col = 1 To UBound(dat, 2)
For rw = 3 To UBound(dat, 1)
If dat(rw, col) = ref_num Then
day = day & dat(2, col) & Sep
End If
Next rw, col
If Len(day) > 0 Then day = Left$(day, Len(day) - Len(Sep))
GetDays = day
End Function
SO this started as me trying to help someone else, got stumped. So basically i have values in columns B, C, and D. if have my criteria in H2 and I2 and when my criteria in H2 and I2 matches in B and C then have the corresponding answer in D to populate J2. basically a vlookup with 2 criteria.
i have something like this.
Sub test()
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngAnswer As Range
Dim strTarget As String
Set rngCrit1 = Range("H2")
Set rngCrit2 = Range("I2")
Set rngAnswer = Range("J2")
Range("B2").Select
strTarget = ActiveCell.Value
Do While strTarget <> ""
With ActiveCell
If strTarget = rngCrit1 Then
If .Offset(0, 1).Value = rngCrit2 Then
rngAnswer.Value = .Offset(0, 2)
Else
.Offset(1, 0).Select
strTarget = ActiveCell.Value
End If
End If
End With
Loop
End Sub
Now this thing just crashes, no debugging or anything. I am self taught so i'm sure i screwed the pooch here somewhere.
*Note this is just to satisfy my own interest not really important, so if it takes you more than 5 min please help someone else that needs it more than I.
Val1 Val2 Val3 Crit1 Crit2 Answer
a r 12 g v 22
b r 14
c s 15
d s 16
e t 18
f t 19
g y 20
g v 22
sample data
It's great that you're trying to improve your VBA skills. The first thing I'd suggest, which will improve any macro you write, is to avoid using .Select. Work directly with the range objects. For instance:
Range("B2").Select
strTarget = ActiveCell.Value
becomes
strTarget = Range("B2").Value
Also, in general, use vbNullString or Len(variable)=0 when checking for "empty" values instead of "". As for why your program is crashing, it may be your use of With. Like Select, it should be avoided in most cases (definitely in this one). Although you update ActiveCell, it's within the scope of the With statement, so once you close it (End With), those changes to ActiveCell are undone (I would suggest stepping through the macro and watch the values of strTarget and ActiveCell). This may not be the case, but I know it holds for other variables, which is why I avoid With (and avoid reassigning values in a With statement)
Anyway, I'd add the following code and rewrite the loop as follows:
Dim r as range
set r = Range("B2") 'keep in mind this range is on the ActiveSheet, so you're better
'off explicitly naming the Sheet e.g. Sheet1.Range("B2")
strTarget1 = Range("B2").Value
strTarget2 = Range("C2").Value
Do While Len(strTarget) <> 0
If strTarget1 = rngCrit1 Then
If strTarget2 = rngCrit2 Then
rngAnswer.Value = r.Offset(0,2)
Exit Do
End If
End If
set r = r.Offset(1,0)
strTarget1 = r.Value
strTarget2 = r.Offset(0,1).Value
Loop
Keep in mind you could also loop with a Long counter i for the row, then call Sheet1.Cells(i,1).Value, Sheet1.Cells(i,2).Value and so on for the values of the different columns of that row (instead of using a range object and .Offset
EDIT: After running your code, the reason for the crash is due to your If statements. You want to go to the next cell regardless. Remove the Else and put the End If statements before the Select. Add an Exit Do after your assignment statement in the 2nd If, since you want to stop looping if your two columns meet the criteria. I've updated my code to show this, as well.
INDEX and MATCH, or SUMPRODUCT tend to work well for this. An example of the former:
http://support.microsoft.com/kb/59482
if you can guarantee val1 and val2 will be unique (e.g. when searching for g & v, there is only 1 line with g and v) then you can use sumifs
I put val1,val2 and val3 in columns A,B, & C, and the search into E,F and the answer in G, and came up with this formula
=SUMIFS(C2:C9,A2:A9,E2,B2:B9,F2)
of course, this fails if val3 is not numeric, or there are more than 1 line with the letters you are looking for