the yellow highighted is where the data is entered lets say cell b2 is data entry.. and i2 to AD2 are the cells in which formulas are suppose to be set.
i need a vba code which identifies b2 = any amount/symbol if its true, I2 to ad2 should insert this if formula [[IF($I$1=D2,G2,"")]
This should be applied in all the rows
Please place this in your worksheet's module.
It checks, whether cell B2 is changed and contains something, and then places the formula in whole range, starting at I2:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RelevantArea As Range
Dim lastRow As Long
Set RelevantArea = Intersect(Target, Me.Range("B2"))
If Not RelevantArea Is Nothing Then
If Len(Target.Value2) > 0 Then
' find the last used row, e. g. in column 9:
lastRow = Me.Cells(Me.Rows.Count, 9).End(xlUp).Row
Application.EnableEvents = False
Me.Range("I2:AD" & lastRow).Formula = "=IF(I$1=$D2,$G2,"""")"
Application.EnableEvents = True
End If
End If
End Sub
The formula is inserted into the range like you would get it, if you copy the formula of the first cell (here: I2) to the rest of the range. I changed the formula a little, assuming you wanted it like that.
By following you get it for the changed row only, i. e. if you paste into e. g. B5:B9, it works for rows 5 to 9.
You can use the A1- or R1C1-notation to adapt the formula to your needs.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MonitoredArea As Range
Dim CurrentRow As Long
Dim CurrentCell As Range
Set MonitoredArea = Intersect(Target, Me.Range("B:B"))
If Not MonitoredArea Is Nothing Then
For Each CurrentCell In MonitoredArea.Cells
If Len(CurrentCell.Value2) > 0 Then
CurrentRow = CurrentCell.Row
Application.EnableEvents = False
With Me.Range(Me.Cells(CurrentRow, "I"), Me.Cells(CurrentRow, "AD"))
.Formula = "=IF(I$1=$D" & CurrentRow & ",$G" & CurrentRow & ","""")"
'.FormulaR1C1 = "=IF(R1C=RC4,RC7,"""")"
Dim i As Integer
For i = xlEdgeLeft To xlInsideHorizontal ' all borders
With .Borders(i)
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(0, 0, 0)
.TintAndShade = 0
End With
Next i
End With
Application.EnableEvents = True
End If
Next CurrentCell
End If
End Sub
Related
Private Sub Worksheet_Change(ByVal Target As Range)
StartRow = 21
EndRow = 118
ColNum = 1
For i = StartRow To EndRow
If Cells(i, ColNum).Value = Range("A4").Value Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i
End Sub
The Range I want to dictate when the code is run is D21:D118. It will start out blank and then have data pulled into it
Thank you!
It's quite difficult and error-prone to tell in a Change event handler what the previous cell value was before it was edited. You might consider narrowing the logic so it only runs if a cell in A21:A118 is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, vA4
'Does Target intersect with our range of interest?
Set rng = Application.Intersect(Target, Me.Range("A21:A118"))
If rng Is Nothing Then Exit Sub 'no change in monitored range
vA4 = Me.Range("A4").Value
For Each c In rng.Cells 'loop over updated cells
c.EntireRow.Hidden = (c.Value = vA4) 'check each updated cell value
Next c
End Sub
I want data in the cells of column J to copy the data in the cells of column G once data is inputted into column G and not before.
However, prior to this replication taking place I would like to be able to manually update the price in the cells of column J.
See the attached photo for clarity.
Could anyone suggest a solution? I know VBA is a possibility, however, my Excel knowledge is not good enough to write code.
Yellow headings represent no formulas and blue represent formulas.
Excel_Worksheet_ TRADE LOG
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("C:C"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -1).ClearContents
Else
With .Offset(0, -1)
.NumberFormat = "dd MMM yyyy"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("G:G"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 12).ClearContents
Else
With .Offset(0, 12)
.NumberFormat = "dd MMM yyyy"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
A Simple Worksheet Change
If values in the column range from G2 to the bottom-most (last) cell of the worksheet, are changed manually or via code, the values of the cells in the corresponding rows in column J will be overwritten with the values from column G.
This solution is automated, you don't run anything.
Sheet Module e.g. Sheet1 (in parentheses in Project Explorer of Visual Basic Editor)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sCell As String = "G2" ' Source First Cell
Const dCol As Variant = "J" ' Destination Column Id (String or Index)
Dim irg As Range ' Intersect Range
Dim cOffset As Long ' Column Offset
With Range(sCell)
Set irg = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
If irg Is Nothing Then Exit Sub
cOffset = Columns(dCol).Column - .Column
End With
Dim arg As Range ' Current Area of Intersect Range
Dim cel As Range ' Current Cell in Current Area of Intersect Range
For Each arg In irg.Areas
For Each cel In arg.Cells
If Not IsError(cel.Value) Then
cel.Offset(, cOffset).Value = cel.Value
End If
Next cel
Next arg
End Sub
I'm trying to clear a range of 5 cells when changing another. For example: H5 is changed, J5:J10 is cleared. This works a treat in clearing J5 when H5 is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address(, False), 1) = "H" Then Target.Offset(, 2).ClearContents
End Sub
However this does not clear the 4 cells below. I was wary of using a function to specify the range as I've got multiple rows of data in H. So for example if H24 changes, J24:J29 are cleared, which goes on for about 200 rows...
Any help is appreciated!
The Offset-function returns a range with the same size than the original Range, just at a different place. To increase (or decrease) the size of a range, you can use the Resize-function. So basically, you need to combine both functions.
I don't want to argue with you about how to check for the column, but I think using If Target.Column = 8 Then is much easier.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 8 Then ' Col H
Dim destRange As Range
Set destRange = Target.Offset(0, 2).Resize(5, 1)
Debug.Print destRange.Address
destRange.ClearContents
End If
End Sub
Be aware that Target may contain more than one cell (eg via Cut&Paste), you probably need to handle that.
This should do it.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Left(Target.Address(, False), 1) = "H" Then ActiveSheet.Range(Target.Offset(, 2), Target.Offset(5, 2)).ClearContents
Application.EnableEvents = True
End Sub
Okay with merged cells offset gets weird and even offsetting the topleft cell of the merged area (Target.MergeArea(1, 1)) will give bad results so we need to create the range ourselves.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.MergeCells = True Then
If Left(Target.Address(, False), 1) = "H" Then ActiveSheet.Range(Target.Offset(0, 2), ActiveSheet.Cells(Target.MergeArea(1, 1).Row + 5, Target.MergeArea(1, 1).Offset(0, 2).Column)).ClearContents
Else
If Left(Target.Address(, False), 1) = "H" Then ActiveSheet.Range(Target.Offset(, 2), Target.Offset(5, 2)).ClearContents
End If
Application.EnableEvents = True
End Sub
I hardcoded the 5 into the row change if you need it to be the size of the merged area you will need to get the difference in rows from the top to the bottom of the merged area.
Clear Cells on Any Side of Merged Cells
The colors in the image show which contents will be cleared in column J if a value in a cell in column H is changed (manually or via VBA).
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim doEnableEvents As Boolean
On Error GoTo clearError
Const FirstCellAddress As String = "H2"
Const ColOffset As Long = 2
Dim irg As Range
With Range(FirstCellAddress)
Set irg = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
End With
If Not irg Is Nothing Then
Application.EnableEvents = False
doEnableEvents = True
Dim arg As Range
Dim cel As Range
For Each arg In irg.Areas
For Each cel In arg.Cells
If cel.MergeCells Then
With cel.MergeArea
.Cells(1, 1).Offset(, ColOffset).Resize(.Rows.Count) _
.ClearContents
End With
Else
cel.Offset(, ColOffset).ClearContents
End If
Next cel
Next arg
End If
ProcExit:
If doEnableEvents Then
Application.EnableEvents = True
End If
Exit Sub
clearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
Sub testMultiArea()
Dim rg As Range: Set rg = Range("H2,H7")
rg.Value = 500
End Sub
I,ve tried to find a VBA solution for finding the previous cell (located on the same row) with different value than the selected cell has. So if the selected cell is for example [N6] (as in my picture) then my search range should be ("A6:N6") from which I need to find the last cell with a different cell value (which would be cell [L6] in my picture because it's the previous cell with a different value than cell [N6]. The search should start from the end (N6,M6,L6...) backwards until the first match is found (first different cell value). When the first match is found then select it. I have hundreds of columns, so my picture is just to show the principle. I execute my vba code with Private Sub Worksheet_SelectionChange(ByVal Target As Range) so when the user selects a cell with the mouse. I get the desired cell with {=ADDRESS(6;MATCH(2;1/(A6:O6<>"D")))} but I would need a VBA solution for my problem. My current VBA solution takes me to cell [I6] instead of [L6] and I can't figure out how to edit my code to find the correct cell ([L6] in my example picture).
Dim rngSel As String, rngStart As String
Dim rngActiveStart As Range
rngSel = ActiveCell.Address(0, 0)
rngStart = Cells(ActiveCell.Row, 1).Address(0, 0)
Set rngActiveStart = Range(rngStart & ":" & rngSel)
Dim c
For Each c In rngActiveStart.Cells
If c <> Target.Value And c.Offset(0, 1) = Target.Value Then
c.Select
MsgBox "Previous different cell: " & c.Address(0, 0)
Exit For
End If
Next
Using selection_Change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, col As Long, x
Dim v As String
r = Target.Row
v = Target.Value
Application.EnableEvents = False
For x = Target.Column To 1 Step -1
With Me
If .Cells(r, x) <> v Then
.Cells(r, x).Select
Exit For
End If
End With
Next x
Application.EnableEvents = True
End Sub
You need a For i = max To min Step -1 loop to loop backwards/left:
Public Sub MoveLeftUntilChange()
Dim SelRange As Range 'remember the selected range 'N6
Set SelRange = Selection
Dim iCol As Long
For iCol = SelRange.Column To 1 Step -1 'move columns leftwards
With SelRange.Parent.Cells(SelRange.Row, iCol) 'this is the current row/column to test againts the remembered range N6
If .Value <> SelRange.Value Then 'if change found select and exit
.Select
Exit For
End If
End With
Next iCol
End Sub
Updated Question
I have a VBA script attached to sheet 1 that uses the B5:B50 cell values to populate the adjacent column with pre-defined text. If I want to use this script in another sheet, but still use the B5:B50 cell values of the previous sheet. How to I do that?
For Example:
In sheet 1, If I enter the value of 2 in the cell B5, it will populate D5 and E5 with the text value attached to CONST TXT. I want to do the same thing in sheet 2, but instead of the user entering the value again into B5 of sheet 2, it just gets the value of B5 from the previous sheet and then populate D5 and E5.
Sheet 2 B values will need to update as soon as the B values are updated in Sheet 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Const NUM_COLS As Long = 5
Const TXT = "• Course Name:" & vbNewLine & _
"• No. Of Slides Affected:" & vbNewLine & _
"• No. of Activities Affected:"
Dim rng As Range, i As Long, v
If Target.CountLarge <> 1 Then Exit Sub
If Not Intersect(Target, Me.Range("B5:B50")) Is Nothing Then
Set rng = Target.Offset(0, 2).Resize(1, NUM_COLS) 'range to check
v = Target.Value
If IsNumeric(v) And v >= 1 And v <= NUM_COLS Then
For i = 1 To rng.Cells.Count
With rng.Cells(i)
If i <= v Then
'Populate if not already populated
If .Value = "" Then .Value = TXT
Else
'Clear any existing value
.Value = ""
End If
End With
Next i
Else
rng.Value = "" 'clear any existing content
End If
End If
End Sub
As I understand you, you want something like an equivalent of offset which returns a range on a different sheet. There are a couple of options.
You can use Range.AddressLocal, which returns the address of Range without any worksheet or workbook qualifiers, and then apply this to the other worksheet:
'returns a cell 1 to the right of rng, but on Sheet2
Worksheets("Sheet2").Range(rng.Offset(0, 1).AddressLocal)
Or you can get the Row and Column properties of your range and use them in Cells in the other worksheet:
'returns a cell 1 to the right of rng, but on Sheet2
Worksheets("Sheet2").Cells(rng.Row, rng.Column + 1)
To use it in your code, I think it's just a case of replacing
If .Value = "" Then .Value = TXT
with
If Worksheets("Sheet2").Range(.Offset(0, 1).AddressLocal).Value = "" Then Worksheets("Sheet2").Range(.Offset(0, 1).AddressLocal).Value = TXT
and replacing
.Value = ""
with
Worksheets("Sheet2").Range(.Offset(0, 1).AddressLocal).Value = ""
(or the same using the Cells construction).
The below will copy the Target.Value into the same cell in Sheet2
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
If Not Intersect(Target, Me.Range("B5:B50")) Is Nothing And Target.Count = 1 Then
With Target
ws2.Cells(.Row, .Column).Value = .Value
End With
End If
End Sub