Excel VBA - range offset - excel

I'm trying to make a code which after insert/update value in one cell, will go to the next cell like on the picture. Now this code works only one way:
ActiveCell.Offset(1,0).Select ex. from A2 to B2.
What to do to return offset to the cell on the left from B2 to A3 - need loop like on the picture.

I am not quite sure if I understood what you are looking!
I set a range on column A and B until row 10, just for testing.
This code moves to the next cell on the picture whenever you edit
the cell and then you press Enter.
Put this code on the sheet module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngColA As Range: Set rngColA = Range("A2:A10")
Dim rngColB As Range: Set rngColB = Range("B2:B10")
If Not Intersect(Target, rngColA) Is Nothing Then
Target.Offset(0, 1).Select
exit sub
End If
If Not Intersect(Target, rngColB) Is Nothing Then
Target.Offset(1, -1).Select
End If
End Sub

Related

Fill the cell with a formula if it's blank

I got a cell which has the formula: =SE(G15<>"";0;"") , it means depending the reference cell isn't blank, it must returns me a 0 in the that cell.
The thing is, sometimes I will have to manually change this cell to another numeric value, erasing the old formula I put, and then in the future this cell will never returns me the 0 again in case I don't put the same formula again.
I want to make a vba code which helps me in that. Every time I delete the cell with the value I put manually, it brings back the formula with the 0, and this in the range F16:Q16.
What I was trying to write is something like:
Sub Worksheet_Change(ByVal Target As Range)
and define the target.range for each cell, but I don't know how to progress anymore.
Please, can someone help in this?
Using the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("F16:Q16")) 'range to be checked
If Not rng Is Nothing Then
On Error GoTo haveError
Application.EnableEvents = False 'stop updates from re-triggering this handler
For Each c In rng.Cells
If Not c.HasFormula And Len(c.Value) = 0 Then
c.Formula = "=IF(G15<>"""",0,"""")" 'use US-style from VBA
' or use FormulaLocal
End If
Next c
End If
haveError:
Application.EnableEvents = True 'make sure events are re-enabled
End Sub

Clear contents of cells in that row when a cell in the same row changes to apply to multiple rows

I have this code
Private Sub Worksheet-Change(ByVal Target As Range)
If Not Intersect(Target, Range(“M4”)) Is Nothing Then
Range("N4:T4).ClearContents
End If
End Sub
Which works for the 4th row When I change M4 it clears N4 to T4
I need a way to adapt this code so that if I change the value of M5 it deletes N5 to T5 and so on for all the rows.
Can you help
You need to intersect the range you want to observe for changes Me.Range("M4:M10") with Target and then use the Range.Offset property and Range.Resize property to move from the changed cell 1 right and resize it to 7 columns to clear contents.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("M4:M10")) 'range to observe
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange.Cells
Cell.Offset(ColumnOffset:=1).Resize(ColumnSize:=7).ClearContents
'or
'Me.Range("N" & Cell.Row & ":T" & Cell.Row).ClearContents
Next Cell
End If
End Sub
Test Target for if it contains a cell in M, and use its row to clear the relevant cells
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl as Range
For Each cl In Intersect(Target, Me.Columns(13))
If cl.Row >= 4 Then
cl.EntireRow.Cells(1, 14).Resize(1, 7).ClearContents
End If
Next
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.

If A1 changes, put something into B1 | If A2 changes, put something into B2

I have rows from 1-100.
I know how to target specific cells and get data from them, but how would I do this when any row from 1 to 100 can be changed?
Say you put anything into Row A3. How would you write "Updated" into row B3 via VBA?
I want this to apply to rows A1-A100.
Thanks
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Intersection As Range, Cell As Range
Set A = Range("A1:A100")
Set Intersection = Intersect(Target, A)
If Intersection Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Intersection
Cell.Offset(0, 1).Value = "Updated"
Next Cell
Application.EnableEvents = True
End Sub
Open VBA Editor
Double click on the sheet you event take action (sheets appears in the left top box)
Select Worksheet on the left box above code box
Select change on the right box above code box
Paste the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, .Range("A1:A100")) Is Nothing Then
Application.EnableEvents = False
.Range("B" & Target.Row).Value = "Updated"
Application.EnableEvents = True
End If
End With
End Sub

Excel VBA - clear cells above and below cell with text

I'm looking for some help please with some VBA.
Let's say I have a range of cells (B4:B12), so if I input data in a cell within the range I would like to clear all cells in the same range except for the cell in which I inputed the data. So that I can only have 1 cell with data in the range.
So if B5 had data and I inputed data in B7 then B5 would clear, then if i entered data in B10 then B7 would clear...
I hope there is a solution as I have been trying to find an answer for the past couple of hours.
I would do it this way:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set myRange = Sh.Range("B4:B12")
'set the current cell/address/value so we don't lose them when the range is cleared
Set cell = Sh.Range(Target.address)
value = Target
'disable/enable so this isn't called every time a cell is cleared
'clear the range then reset the to entered value
If Not Intersect(Target, myRange) Is Nothing Then
Application.EnableEvents = False
myRange.Clear
cell.value = value
Application.EnableEvents = True
End If
End Sub
Or you could use worksheet event to bevplaced in the relevant worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
With Range("B4:B12") ‘reference your range
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then ‘ if changed range is one cell within the referenced one
myVal = Target.Value ‘store changed cell value
Application.EnableEvents = False
.ClearContents ‘ clear the content of referenced range
Target.Value = myVal ‘ write changed cell value back
Application.EnableEvents = True
End If
End With
End Sub

Resources