Excel, Visual Basic Changing the Range a formula uses - excel

The below code I found online and I started adapting it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(-1, 1).Value = Now
Next r
Application.EnableEvents = True
End Sub
What I really need to change is instead of this code applying to the entire A column, I need it to start at a specific cell, and apply to every nth cell after that, in a given column.
Can I accomplish that by just modifying the syntax below, or do I need to write a new formula?

If I understand your wishes
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("B5:C15") ' "B5:C15" - range in which we want to track changes (сan change)
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
ActiveSheet.Range("E" & r.Row).Value = Now ' "Е" - сolumn for insert the date of change (сan change)
Next r
Application.EnableEvents = True
End Sub

Thank you for responding. That indeed helps clarify some of the ways to define range. Here is a better picture of what I am trying to do:
Solution 1:
I have kind of solved it in a very inefficient way. I have a repeating table on a spread sheet that we just C&P as needed. As long as everyone C&P with the same spacing, my solution works by changing the range to this:
Set A = Range("A5,A10,A15,A20,A25") And then I just add as many increments as I think we will need.
Obviously this is not a desirable way of doing this; I would like to know how to code it so it will do every 5th row in the entire A column, to infinity.
Solution 2:
Probably more advanced than I care to get to in visual basic, but ideally I would like the script to search for a specific word in a cell, and then execute on the next row down. So if it finds the word "Current" in Cell A4, it will execute the script on Cell A5.
If I could make this work, then it would not matter if someone messed up the spacing.
I appreciate your help!

Related

Work around for x64 bit limit - Worksheet.change

My problem is I'm trying to make a sheet that update the date on the row where data is being edit.
But I have around 600 rows, and the limit for the one code (Worksheet_change) is by far exceeded before I reach the bottom.
My code is like this
Private Sub Worksheet_change(ByVal target As Range)
If Not Application.Intersect(Range("E7:AR7"), Range(target.Address)) Is Nothing Then
Range("AS7") = Range("A1")
End If
If Not Application.Intersect(Range("E8:AR8"), Range(target.Address)) Is Nothing Then
Range("AS8") = Range("A1")
End If
Just continues up to 600+. (I have a spreadsheet to write the code for me, so not that much work)
But it is when I didn't thought about the limit.
Is there a workaround or some similar code that gets the job done?
Just to make it Clear what I'm trying to do, if it isnt from the code itself.
When a user edit some data between E7:AR7 then AS7 = today()
And down the rows.
E8:AR8 then AS8 = today()
E9:AR9 then AS9 = today()
E10:AR10 then AS10 = today()
-##-
Hope you guys have some ideas :)
You don't need a separate If statement for each range.
The code below will check for changes in E7:AR700 and put the value from A1 in column AS of the row that's been changed.
You can adjust E7:AR700 to suit.
Private Sub Worksheet_change(ByVal Target As Range)
Dim rng As Range
If Not Application.Intersect(Range("E7:AR700"), Target) Is Nothing Then
Application.EnableEvents = False
For Each rng In Target.Cells
Range("AS" & rng.Row) = Range("A1")
Next rng
Application.EnableEvents = True
End If
End Sub

Issues with VBA code for a range. I'm getting Type Mismatch Error 13

The code below works for an individual cell, but I get type mismatch when i want to implement this for a range. Would appreciate it if someone can make the below work. Thanks.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A159:A1034").Value = "SC" Then
Range("J159:J1034").Value = "SC:NA"
Else
Range("J159:J1034").Value = Null
End If
End Sub
Even if Range("A159:A1034").Value would work – which it doesn't – it would have to return the value of 875 cells at once. Most likely not what you want.
The easiest way to loop through the range and make the adjustments, would be something like:
Dim area As Range, c As Range
Set area = Range("A159:A1034")
For Each c In area
If c.Value = "SC" Then
c.Value = "SC:NA"
Else
c.Value = Null
End If
Next c
But I do not recommend to use that in a Worksheet_SelectionChange event for multiple reasons.
First, it will be a pretty heavy operation, which will run each time a change in selection is made. Making the whole worksheet very slow to work with.
Secondly, any cells that does contain "SC" will be changed to "SC:NA", but on next change in selection, they will all disappear. Since they will fail the check and be turned to "Null". This seems like very odd behavior.
IF you want to run it in a worksheet event, you could maybe run it in a Worksheet_Change event instead, and limit it to only run as a change in this range is made.
Something like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim area As Range, c As Range
Set area = Range("A159:A1034")
If Not Intersect(Target, area) Is Nothing Then
Application.EnableEvents = False
If Target.Value = "SC" Then
Target.Value = "SC:NA"
Else
Target.Value = Null
End If
Application.EnableEvents = True
End If
End Sub
And if you want to trigger a check on the entire range – like the first example, make that a separate sub, that you call as a macro.

Add Xlookup to a range via Excel VBA

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

Excel, search multiple columns for cells that contain partial similar data

Wonder if someone could give me a pointer, or maybe it's already been ask then just a reference, but how can I highlight cells in an excel spreadsheet that contains multiple columns where any portion of a text matches?
Example say cell A2 has the text 'Ionized Sea Salt' and cell D5 has 'Salt'. I would like to highlight those cells because of the matching word 'Salt'.
I don't want to have to add the word I'm searching for in the formula because all the cells and columns will contain hundreds of different strings and I'm looking for matching word(s) per cell.
Thanks
Allthough you should have attempted to at least start coding something, this one is quite fun to work on so hereby my attempt :)
Sub Hightlight()
Dim MyArray() As String
Dim X As Long
Dim C As Range
ActiveSheet.UsedRange.Cells.Interior.Pattern = xlNone 'Clear the hightlighted cells
MyArray() = Split(ActiveCell.Value, " ") 'Get the activecell and split it in array
For X = LBound(MyArray) To UBound(MyArray) 'Loop through your array using .findnext
With ActiveSheet.UsedRange
Set C = .Find(MyArray(X), lookat:=xlPart)
If Not C Is Nothing Then
firstaddress = C.Address
Do
C.Interior.ColorIndex = 37 'color found matched cells
Set C = .FindNext(C)
If C Is Nothing Then
GoTo DoneFinding
End If
Loop While C.Address <> firstaddress
End If
DoneFinding:
End With
Next X
End Sub
The biggest plus of this approach is it wont have to go through thousands of cells, so therefor should be relative fast.
I am sure some true expert can cleanup this code even better :)
Input:
Output:
So.... add a button to your sheet, assign the macro, select a cell, hit the button...
Untested but should work:
Private Sub reset_highlighting()
ActiveSheet.Cells.Interior.Color = xlNone
End Sub
Private Sub highlight_d5()
' Call reset_highlighting < remove comment if you dont want to store prev results
Dim lr as Long
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Dim search_range as Range: Set search_range = Range(Cells(1,1), Cells(lr, 1))
Dim search_value = Range("D5").Value2
For each cell in search_range
If (InStr(Trim(LCase(cell.Value2)), Trim(LCase(search_value))) != 0) Then
cell.Interior.Color = vbYellow
End If
Next cell
End Sub
Note, you should replace ActiveSheet with Sheets("YourSheetName")
and also might want to adjust your range to fir the criteria
accordingly
PS: Post your efforts of you trying to solve the question in the future. Questions where no attempt was made generally tend to get downvoted here, I only made an exception given you're new here (and I have a good mood today)

How to Set a Range outside a Loop and use it inside

Î've read lots of questions recommanding me to avoid using Select. So I've tried to set a target cell but I've met a problem:
I want to use a For Loop to fill a table, but the target cell will change each time with the Loop going on. For example:
Sub try()
Dim target As Range
Set target = Worksheets("Data").Cells(i, 1)
For i = 1 To 10
target.Value = i
Next i
End Sub
So can I use a Range in Loop or not?
If I set the target in the For Loop, I'm afraid it will not be faster than I choose directly the cell Worksheets("Data").Cells(i, 1)in the Loop? Because I'll actually have lots of targets to use, so I wish to find a easier method to set the targets and fill them everytime without setting them one by one.
Sorry if I've post a duplicate question because I didn't find a similar question or an answer on the net. If you've got an idea, please leave a comment. Thank you!
Based on your comment about "reading" each line. This code uses a For Each and examines each cell to see what to do.
Public Sub Test()
Dim rMyRange As Range
Dim rCell As Range
'Define a range on the same sheet.
Set rMyRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:A15,C1:C20,D18,E19:E20")
'Add another range using Union just for the hell of it.
Set rMyRange = Union(rMyRange, ThisWorkbook.Worksheets("Sheet1").Range("F30"))
'Step through each cell in rMyRange and decide what to do based on contents/formatting of cell.
For Each rCell In rMyRange
If rCell = "Colour" Then 'Value is default property.
rCell.Interior.Color = RGB(255, 0, 0)
Else
Select Case rCell.Font.Color
Case 255 'Red
rCell = "Red"
Case 5287936 'Green
rCell = "Green"
Case Else
rCell = "Some Other Colour"
End Select
End If
Next rCell
End Sub

Resources