Add Xlookup to a range via Excel VBA - excel

I tried searching for a solution to my XLookup via VBA problem but I couldn't find one. I have this below data set:
In the Data Set, If any cell in the range C2:C6 is blank, I want to use this formula =IF(ISBLANK(B2),"",XLOOKUP(B2,A:A,IF(ISBLANK(D:D),"",D:D))) in those cells. Where row number of B2 is variable depending upon the row we are putting this formula via VBA.
If any cell in the range C2:C6 has value, I want to use that value without any formula. And if someone deletes the value and the cell becomes blank, VBA will add above formula to that cell.
Currently in the screenshot above, all the cells in range C2:C6 has above formula.
I hope I made sense. If this is not doable, it's okay. I can always use a helper column. But I think VBA would be a more cleaner way for my Dashboard.
Many Thanks in Advance.

In the sheet's class module, put this code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
For Each rCell In Me.Range("C2:C6").Cells
If IsEmpty(rCell.Value) Then
Application.EnableEvents = False
rCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",xlookup(RC[-1],C[-2],IF(ISBLANK(C[1]),"""",C[1])))"
Application.EnableEvents = True
End If
Next rCell
End Sub
This will run every time something on the sheet changes. That can't slow things down so you don't want to try to do too much in the Change event. It does not fire on calculate, though.

This one seems to be working for any set of data. Thanks to everyone for the help:
Private Sub InsertFormula()
Dim mwRng As Range
Set mwRng = Range("C2:C250")
Dim d As Range
For Each d In mwRng
If d.Value = "" Then
d.Formula = "=IF(RC[-1]="""",""-"",INDEX(C[1],MATCH(RC[-1],C[-2],0)))"
End If
Next d
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("C2:C250")) Is Nothing Then
Application.EnableEvents = False
Call InsertFormula
Application.EnableEvents = True
End If
End Sub

Related

Excel VBA - Copy a formula result to a cell in another sheet + add succesive formula results in consecutive rows each time the formula is recalculated

I am running a partially randomize set of data and trying to find the best solutions depending on certain parameter changes. I need to "record" certain solutions and then compare different results for different parameters each time the randomized variables are recalculated.
I would like to do the to following:
On Sheet1, cell S255, is the result of a formula =SUM(M252:S252)
I need to automatically add that result (Sheet1 S255), to Sheet5, column A, starting at A1.
Then, each time the formula is recalculated and the result changes, I need the new result to be added to the consecutive row to the previous result (so the second result would go to A2, third one to A3, and so on).
Looking for similar cases I have come to be able to do 1. and 2. using this event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet5") 'declare and set the worksheet the data is to be copied into, amend the sheet name as required
If Target.Address = "$S$255" Then 'if anything changes in C6 or C9 in this sheet
ws.Range("A1").Value = Target.Parent.Range("S255") 'copy the value from cell C10 in this sheet to Sheet2 in cell E5
End If
End Sub
Doing 3. is proving more challenging. What event would be suitable to do so?
Thanks in advance for your time and understanding!
Thats how you are able to solve it with the Worksheet_Calculate event like BigBen suggested. Under "Random numbers" are just a few numbers with the RANDBETWEEN-Function for showing puposes. Just change the code for your case. Everytime you press "Delete" for exaple the new sum will be set under the Results column.
Private Sub Worksheet_Calculate()
Dim lastRow As Long
'EnableEvents must be switched off so that the macro does not
'call itself in an endless loop by cell change
Application.EnableEvents = False
lastRow = WorksheetFunction.CountA(Range("C:C")) + 1
Range("C" & lastRow).Value = Range("A9").Value
Application.EnableEvents = True
End Sub
'example saving sum ONLY IF SUM CHANGES
Private Sub Worksheet_Calculate()
Dim offsetLastSum As Long, curSum As Double
offsetLastSum = Range("NEXT_SUM_OFFSET").Value2
curSum = Range("THE_SUM").Value2
With Range("SUM_HISTORY_HEAD")
If .Offset(offsetLastSum - 1).Value2 <> curSum Then
Application.EnableEvents = False
.Offset(offsetLastSum).Value2 = curSum
Application.EnableEvents = True
End If
End With
End Sub

Add a Value Automatically to a Cell Based on Another Cell

I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)
To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.

How do I Autofill a cell with string depending if it's in another list?

I'm trying to create a sheet where I can type one text value in and it autofills with the closest possible match from another list of strings.
I've tried using the VLOOKUP function in VBA, with 4th argument set to TRUE to look for a partial match. I've also tried using the VLOOKUP function in excel only and not VBA. The result is half of what I want, let's say I enter "cookie" in the cell, the function returns "Cleaning Supplies" since they both start with a C. Ideally, I'd want it to return Chocolate Cookie or something similar to that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Target.Value = Application.WorksheetFunction.VLookup(Target.Value, Worksheets("StorageLocations").Range("A:A"), 1, True)
End If
End Sub
The code works partially, coming back with a run-time error Method 'Range' of object_ '_Worksheet' failed. It also only comes back with the cleaning supplies comment from earlier.
Any help is appreciated.
Try:
In Worksheet event paste
Private Sub Worksheet_Change(ByVal Target As Range)
Call fnd(Target)
End Sub
In a New Module Paste
Sub fnd(rng As Range)
Application.EnableEvents = False
If rng.Column = 1 Then
If Not Worksheets("StorageLocations").Range("A:A").Find(rng) Is Nothing Then
rng.Value = Worksheets("StorageLocations").Range("A:A").Find(rng.Text).Value
End If
End If
Application.EnableEvents = True
End Sub
Explanation:
We need this Enable Events to change the value in Sheet, otherwise while changing the cell value it will keep firing the Change Event.
It will always give you the First available Match in the Column
Demo:

Creating place holder text in Excel

I'm still fairly new to excel but I can just about work out some simple formulas. I'm looking to create a placeholder text effect. The way I want to achieve this is like so;
Cell A1 : has the place holder text and is hidden.
Below this, cell B1 containing the formula.
This formula checks to see if Cell C1 is blank if C1 is blank it returns a value to C1. That value being the value of A1.
This is what I have in my head but I'm unsure on how to code this. I have bounced around the web for a while but I can't find a specific answer. The closest I have gotten is;
=IF(C6<>"","",C4)
Just to clarify Im looking to oput the result of formula B1 into C1.
OK, so put this in the worksheet's code module. Make sure you put it in the module for the specific sheet you're monitoring.
First, fill your range C5 through C99 with the formula like =$C$1. You should only need to do this one time, the macro will take care of it later.
Private Sub Worksheet_Change(ByVal Target As Range)
'the formula reference
Dim defaultFormula As String
defaultFormula = "=$C$1"
'The default text cell:
Dim defaultText As Range
Set defaultText = Range("C1")
'The cells you want to monitor:
Dim rng As Range
Set rng = Range("C5:C999") '## Modify as needed
'Cell iterator
Dim cl As Range
If Intersect(Target, rng) Is Nothing Then Exit Sub
'Avoid infinite looping
Application.EnableEvents = False
'If the user has deleted the value in the cell, then replace it with the formula:
For Each cl In Intersect(Target, rng)
If Trim(cl.Value) = vbNullString Then
cl.Formula = defaultFormula
End If
Next
'Turn on Events:
Application.EnableEvents = True
End Sub
What this does is (hopefully) pretty self-explanatory from the comments in the above code The Change event is raised any time a cell on the worksheet is changed.

Is it possible to create a formula that locks a range using VBA?

I need to lock a range of cells based on another cell's value. This is obviously impossible using worksheet functions, and subs only run at click.
Can I create a formula that locks cells with VBA? I tried this but the formula returns #VALUE! error.
Function lo(range)
lo(range) = range.Select
Selection.Locked = True
End Function
Thanks.
Here's an example:
Sheet1 Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> 1 Then
Target.Offset(0, 1).Locked = True
Else
Target.Offset(0, 1).Locked = False
End If
End Sub
Important: You have to set all cells locked property to False by default.
Thisworkbook code: For above to work, you have to add another event.
Private Sub Workbook_Open()
Sheet1.Protect userinterfaceonly:=True
'Thisworkbook.Sheets("Sheet1").Protect userinterfaceonly:= True
End Sub
What above does is protect Sheet1. I used its code name although it can be written also using the commented line.
Sheet1 is where you set up all cells locked property to false.
So everytime you enter something in a cell, if it is not 1, the adjacent cell will be locked for editting.
Hope this somehow help your purpose.

Resources