I am working on an Excel project and I wanted to implement a UDF to change the value of multiple cells. I tried the following code I found on another thread to change value on an adjacent cell, so I played a bit around with the Offset parameters:
Function clear_it()
Dim pas As String
pas = "Call del(" & Application.Caller.Offset(0 , 6).Address(False, False) & ")"
Evaluate pas
End Function
'---------------------------
Sub del(rng As Range)
rng = 0
End Sub
This code worked as intended and it "deleted" the cell which was 6 places to the right by setting its value to 0!
Following the same logic, I tried the following code to delete multiple cells on the same column:
Function clear_it()
Dim pas As String
Dim i As Integer
For i = 0 To 5
pas = "Call del(" & Application.Caller.Offset(0 + i, 6).Address(False, False) & ")"
Evaluate pas
Next i
End Function
'---------------------------------------
Sub del(rng As Range)
rng = 0
End Sub
However this code just crashed my Excel Workbook and it bricked it. The file was just restarting and crashing on an infinite loop and I could not access the code to change it. So I had to delete the file permanently.
To clarify my intentions:
I have a column of data. When I set a particular cell to 0, I want 5 cells beneath it to also become 0 automatically, without pressing a button or something like that, so I wanted to create something like an If formula 6 cells to the left which calls my function:
=IF(J6 = 0; clear_it();0)
To further clarify my attempts:
I have only tested it by putting the above condition on a single cell, hence an infinite loop by recursive 0 valued cells is not possible.
Can anyone perhaps help me on what the problem might be or if I am trying something I shouldn`t with the UDF behaviour? Or is my approach to this problem totally wrong and there is a simpler way to do this on Excel?
Related
I wrote some code and have a question.
I sucessfully make macro which insert formular into cell.
Problem is It is not working automatically.
Function test(PCell As Range) As String
test = Chr(61) & Replace(PCell.Address, "$", "")
End Function
Cell shows =N3 (simple example). And I can execute Push "F2" - "Enter". It is working well.
Problem is .. There are more than 100 cells. If there is no solution, I have to push F2 - Enter 100 hundred times.
After select the cells, How can I execute the formular in cells? or by using VBA?
I tried to use Selection.Evaluate() But there is nothing happened. And "F9" key is also.
There is a faster and simpler way to achive this result.
'''vba
Sub ExecuteBulkFormula(SrcRng as Range,TgtRng as Range)
'What this procedure does is it loops through every area in the
'SrcRng and then loops through every cell in this area
'It then writes the formula in the array
'i: Loop Counter
'arr_index: Array Items Counter
'r_area: Every range contains atleast one Area as a Range Object
'The usage of Area is essential, as sometimes if we select multiple
'areas, For Example: A1:C2 & A5:C6, Then we can access these two "areas"
'The screenshot for the areas is added below (Figure 1).
'If however, we don't use Areas then we can only access the first Area
'i.e. A1:C2
Dim i as Long, arr_index as long
Dim r_area as Range
Dim arr as Variant
Redim arr(1 To 1000)
arr_index = 1
For Each r_area In SrcRng.Areas
For i = 1 to r_area.count
'Just Replace the below line to change the formula to fit your needs
arr(arr_index) = Chr(61) & Replace(r_area(i).Address, "$", "")
arr_index = arr_index+1
Next i
Next
Redim Preserve arr(1 To arr_index)
TgtRng.Formula = arr
End Sub
Figure 1
How to use this function?
In excel worksheet, press Alt+F11 or Developer Tab->Visual Basic
Right Click in any item in Project Explorer and then select Insert->Module
In this module, insert this above code.
To run this code you can use the immediate window (Ctrl+G) or write another procedure to run this code.
Suggestions
Instead of using Replace you can use Range.AddressLocal(False,False)
It will produce the same result.
This function ExecuteBulkFormula will run very fast
For 1000 rows: 0.016 sec (or 16 milliseconds)
For Reference my laptop is dual core i7-5500u which is low end.
to have function calculate at every sheet change, just add Application.Volatile (see:https://learn.microsoft.com/en-us/office/vba/api/excel.application.volatile)
Function test(PCell As Range) As String
Application.volatile
test = Chr(61) & Replace(PCell.Address, "$", "")
End Function
to place that cell in all cells of a given range:
Sub PlaceTest()
With Range("A1:A10") ' change the range address to to fit your needs
.Formula = "=test(RC[1])" ' this will feed the function with the cell 1 column to the right of where the function is placed: just play around with R1C1 notation (https://excelchamps.com/formulas/r1c1/)
End With
End Sub
First time posting, apologies if I make any mistakes!
So, I'm having a pretty strange problem with my UDF. In my workbook, I have an invisible 'template' sheet named "Standard Phase Sheet", and a subroutine that a user can activate which copies that template sheet into a new, visible sheet that the user can then work with. There will be many copies of that template sheet throughout the workbook, but they will all have unique names.
My UDF is on that template sheet in several spots, and thus on every copy of the template sheet that a user makes. When working within one of these sheets, the UDF works just fine, and returns the values I'd expect.
However, when a user ADDS a new copy of the template sheet, SOMETIMES the UDF goes haywire and returns #VALUE errors in every place the UDF is being used.
Also, when a user DELETES one of the copies of the template sheet, the UDF ALWAYS goes haywire and returns #VALUE errors in every place the UDF is being used.
I'm not using ActiveSheet or anything like that, and I believe I'm correctly giving full references to the ranges I'm working with within the UDF. Any help will be appreciated, I'm in a bind here! Code for the UDF is below.
Also, because I'm sure I'll be asked the question, the neColumn variable within my code is a public variable that I use in several subroutines and UDFs. It is defined at the beginning of my module. Also, I am using Option Explicit at the beginning of my module as well.
Thank you!
Public Function fSum(ByVal Target As Range, bExtended As Boolean) As Single
'This function returns a sum, based on a range provided in the cell that holds the function.
'It checks to see if that line item has been marked as Non-Extended, based on the NE column
'that can be check marked. If that line item is marked NE, then only the NE sum columns can
'use that line item as part of their sum, and those values are removed from the E columns.
Dim sSum As Single
Dim i As Integer
Dim n As Integer
'This small section is used to determine complete references to the cell calling the function.
Dim sheetName As String
sheetName = Application.Caller.Parent.Name
'Loop through provided range, and sum up the contents based on whether they have been marked NE or not.
i = 1
n = Target.row
sSum = 0
If Sheets(sheetName).Visible = True Then
While i < Target.Rows.Count
If (bExtended = True) Then
If Sheets(sheetName).Range(neColumn.Address).Cells(n, 1) = vbNullString Then
sSum = sSum + Sheets(sheetName).Range(Target.Address).Cells(i, 1).Value
End If
Else
If Sheets(sheetName).Range(neColumn.Address).Cells(n, 1) <> vbNullString Then
sSum = sSum + Sheets(sheetName).Range(Target.Address).Cells(i, 1).Value
End If
End If
i = i + 1
n = n + 1
Wend
End If
fSum = sSum
End Function
Summarizing the comment thread in an answer for posterity:
I'm not sure why exactly you see this behavior.
There would be ways to better this UDF (including using Long instead of Integer, preferring a Do While...Loop to While...Wend, removing the .Visible check...
But in any case, it does feel like this is just replicating the functionality of SUMIFS so you might just consider going that route.
The reason is that your neColumn variable has become Nothing, because Excel is Volatile.
I assume that the start of your module looks something like this:
Option Explicit
Public neColumn As Range
Sub Auto_Open()
Set neColumn = Sheet1.Range("A1:B2")
End Sub
When you open the Workbook, you call the Auto_Open Sub to Set the neColumn variable. However - when certain actions occur, Excel rebuilds the VBA, which resets the Public Variables (such as neColumn) to their defaults (which, for an Object such as a Range, is Nothing). An easy way to trigger this is by deliberately throwing an error, such as attempting to run this:
Sub ThrowErr()
NotDefined = 1
End Sub
You can make it more visible to you by adding the following line to your fSum code:
If neColumn Is Nothing Then Stop
You either need a way to restore neColumn when it has been reset to Nothing, OR find a non-volatile way to store it.
I am assuming that this is not suitable to become a Const, because otherwise it already would be but you could turn it into a Named Range, or store the Address in a hidden worksheet / CustomDocumentProperty. These options would also allow you to store neColumn when the Workbook is saved for when you reopen it
I am working with two different Worksheets in one workbook. My task is to look up the model# of a product from Sheet1, find that same model# in Sheet2, and get the cost of that product, which is located a few columns away.
So naturally, I tried to use Vlookup, because that function is enough for this query.
I will post my code below, and then explain the problems I am facing. I am new to VBA and have searched many many different Stack posts, and tried the various solutions, to no avail.
Private Sub CommandButton1_Click()
Dim tbdCell As Range
Dim model As Range
Dim cell As Range
Dim PAsheet As Worksheet
Dim DB As Worksheet
Dim target As Variant
Set DB = Worksheets("Database")
Set PAsheet = Sheets("Pricing Agreement")
Set tbdCell = Range("N2:N4700")
On Error GoTo ErrHandler:
For Each cell In tbdCell
Set model = cell.Offset(0, -6)
cell = WorksheetFunction.VLookup((CStr(model)), PAsheet.Range(CStr("C2:D2000")), 6, True)
Next cell
Exit Sub
ErrHandler:
Select Case Err.Number
Case 0
Case 1004
cell = "missing"
Resume Next
Case Else
MsgBox Err.Number & vbNewLine & Err.Description
Exit Sub
End Select
End Sub
So upon debugging and testing, most things work until we get to the line where I use the Vlookup function. I invariably get error 1004, even though the data exists in the other spreadsheet. So the cells that I need to fill will always fill with "missing" as posted above in the Error Handling Code.
I tried using the Application version of the function. I tried using different variables and declaring them as Variant type. I even tried making the table_array range just one row with 2 column coverage, in an attempt to force a match for one particular model #. So far, to avoid a type mismatch, I cast 'model'(the model#) into a String, and I also cast the search range in PAsheet to String. The final thing I tried was to not search for an exact match(last argument was set to true)
So in anticipation of future questions about the data that the Vlookup is based on, I will include necessary information about how both sheets are formatted.
Info that you may need:
We start in column N, where the prices are missing in Sheet1(Database).
I set model to the value in the same row, 6 columns to the left(Column H).
Testing with MsgBox proved this to work for me, and on debug, the model variable displays the correct info, so this isn't the issue.
In PAsheet, the model #s are in column C. Originally I made the search table from C2:C2000 or so, but I was led to believe that you need at least a two column table for Vlookup to work, so I changed C2000 to D2000. Now the search range is a two column table.
In PAsheet, the cost of the product is in Column H, which is 5 away from column C. I need this value, so I put 6 in the column_index argument. It was 5 before, because I thought that you didn't count the first column, but I fixed that.
Finally I mostly tested with "False" as the last argument, but either way it doesn't work.
So after trying more than two dozen variations and strategies, I still get "missing" in the cells that I need to fill.
So, what am I doing wrong here? Thanks in advance.
If you are trying to return the 6th value from Column C your range needs to be updated to `PAsheet.Range("C2:H2000")
cell.Value = WorksheetFunction.VLookup(cell.Offset(, -6), PAsheet.Range("C2:H2000"), 6, False)
I am trying to automate a rolling calendar spreadsheet that tracks various metrics and charts them into a spark line. The script I would like to write would shift the selected range in the spark-lines every time it is ran.
I have done some googlefu and have tried using the offset function to no avail. This is because the data is in a predefined range defaulting to num 0 based on the formulas used to populate the spreadsheet int the first place.
excel vba : selected cells loop
https://www.excel-easy.com/vba/examples/loop-through-entire-column.html
https://support.microsoft.com/en-us/help/291308/how-to-select-cells-ranges-by-using-visual-basic-procedures-in-excel
I am stuck at incrementing the ActiveCell.SparklineGroups.Item(1).Item(1).SourceData from its current selected range to PPTracking!G8:R8 ... H8:S8 ... and so on each time the macro is ran.
This is my first time working in VBA and any help is greatly appreciated!
Sub Macro4()
Dim selectedRange As Range
Set selectedRange = PPTracking!F8:Q8
Range("E5:E6").Select
Application.CutCopyMode = False
ActiveCell.SparklineGroups.Item(1).Item(1).SourceData = "PPTracking!F8:Q8"
Range("E5:E6").Select
End Sub
You can either use Sparkline.ModifySourceData or directly change the Sparkline.SourceData property, as it looks like you are currently aiming to do.
This code will shift the SourceData 1 column to the right - from F8:Q8 to G8:R8, then to H8:S8, etc. - by using the original SourceData value as a reference within Range, which is then Offset by 1 column.
It concatenates the Parent.Name to the Address to get the full Worksheet Name and cell reference.
Sub ShiftSparklineData()
If ActiveCell.SparklineGroups.Count > 0 Then
With ActiveCell.SparklineGroups.Item(1)
.SourceData = "'" & Range(.SourceData).Parent.Name & "'!" & Range(.SourceData).Offset(, 1).Address
End With
End If
End Sub
Avoid using ActiveCell where possible though; reference the cell(s) with a sparkline using Sheets("Yoursheetname").Range("Cellreference")
I´m using a UDF that is basically a vlookup simplified. Here´s the code:
Function SUELDOBASICO(Columna As Integer) As Double
SUELDOBASICO = Application.WorksheetFunction.VLookup(Application.Caller.Parent.Cells(Application.Caller.Row, 3), Application.Caller.Parent.Parent.Sheets("Escalas Salariales").Range("A3:DJ23"), Columna, False)
End Function
I´ve noticed that sometimes when copying sheets(within the same workbook), I get a #VALUE error. If I "edit" the cell in Excel, changing nothing, just using F2 and Enter, the error disappears. It used to happen when simply changing windows (to Firefox, and back to Excel, for instance). That´s why I used Caller and Parent so much in the code. It is almost completely fixed, except when copying sheets sometimes. I can´t seem to find the source of the error.
Help please.
I know this isn't your exact question, but, if at all possible, I would suggest to just avoid VBA completely if that's at all an option and write your formula as follows:
=VLOOKUP(INDIRECT("C"&ROW()),'Escalas Salariales'!$A$3:$DJ$23,XXXXX,false)
and XXXXX can be the same as your Columna variable currently.
That would guarantee your code to work as needed.
Given what was discussed in the comments and trying my absolute best to ensure this works, I actually don't see anything wrong with your code and am just GUESSING it may have something to do with Application.Caller.
When this kind of thing happens to me, I try my best to just use the debugger to figure out why - That usually involves either Stop statements to be able to step into code and see what happened or Debug.Print Err.Description kind of messages.
Either way, I tried to break each part down, so, at the very least you can see where the issue comes from.
To do so, I re-worked your function (with some major overkill)....
Function SUELDOBASICO(Columna As Integer) As Double
On Error GoTo ErrorCheck
Dim CellRef As Range
Dim LookupRef As Range
Set CellRef = Cells(Application.Caller.Range("A1").Row, 3)
Set LookupRef = Application.Caller.Worksheet.Parent.Sheets("Escalas Salariales").Range("A3:DJ23")
SUELDOBASICO = Application.VLookup(CellRef, LookupRef, Columna, False)
Exit Function
ErrorCheck:
Stop
Resume
End Function
(Also note that I changed Application.WorksheetFunction.VLookup to Application.VLookup - Look at this link for an explanation)
Once you figure it out, I would, though, remove the error code from the function as that isn't a good idea for production code - Just for Debugging.
Hopefully that can give you the answers you are looking for.
Hope that helps....
UPDATE #2:
Taking into account the possibility that copying the sheet is causing this error, here's a test to see if the process gets fixed:
Function SUELDOBASICO(Columna As Integer) As Double
On Error GoTo ErrorCheck
Dim NumTimesErrored As Integer
Dim StartTime As Double
Dim WaitSeconds As Integer
NumTimesErrored = 0
Dim CellRef As Range
Dim LookupRef As Range
Set CellRef = Cells(Application.Caller.Range("A1").Row, 3)
Set LookupRef = Application.Caller.Worksheet.Parent.Sheets("Escalas Salariales").Range("A3:DJ23")
SUELDOBASICO = Application.VLookup(CellRef, LookupRef, Columna, False)
Exit Function
ErrorCheck:
' This will make it tries this "hack" up to 3 times:
If NumTimesErrored < 3 Then
StartTime = Now
WaitSeconds = 1 ' Wait one second
Loop While Now - TimeStart < TimeSerial(0, 0, WaitSeconds)
DoEvents ' Allows all the other processes to complete
Loop
' Increment the number of times you've tried this:
NumTimesErrored = NumTimesErrored + 1
' Go back to the calculation step that errored
Resume
End If
Stop
Resume
End Function
The is no need to use caller and parent.
Function SUELDOBASICO(Cell as Range, LookupRange as range, Columna As Integer) As Double
' When you call the function :
' set Cell to be the cell in column C in the same row
' Set LookupRange to Sheets("Escalas Salariales").Range("$A$3:$DJ$23")
SUELDOBASICO = Application.WorksheetFunction.VLookup(Cell, LookupRange, Columna, False)
End Function
example of formula in a cell...
=SUELDOBASICO(C10,'Escalas Salariales'!$A$3:$DJ$23)