In Sheet1 I have a table with data (no formulas), Range A1:R53. If I update any of the cells, I would like the entire row to be copied and pasted in Sheet2 with the new data.
I don't want the entire table to be copied over, only the row that had a cell changed and the font color to be red. The rows should be pasted in the next available row and not overwrite the previous entries.
Place this event macro in the Sheet1 worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, N As Long
Set rng = Range("A1:R53")
If Intersect(rng, Target) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Target.Interior.ColorIndex = 27
With Sheets("Sheet2")
If .Cells(1, 1).Value = "" Then
N = 1
Else
N = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Target.EntireRow.Copy .Cells(N, 1)
End With
End Sub
Adjust the color to suit your needs.
Related
The final goal includes having a table on Sheet1 and when certain criteria is met in the last column of the table, the row is copied to Sheet2 and contents are cleared from that row in Sheet1. What I have now works, and accurately copies and clears the data, but it copies past the last column of the table. Is there a function I can add to limit the number of columns copied? I only want columns A to I copied to the second sheet and then cleared from the first.
This is what I have currently. The reason I want to limit the columns copied and cleared is because I want to have another table next to it.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 Then
Application.EnableEvents = False
Dim r As Long
r = Target.Row
Dim Lastrow As Long
Lastrow = Sheets("Tasks").Cells(Rows.Count, "I").End(xlUp).Row + 1
If Target.Value = "Complete" Then
Rows(r).Copy Sheets("Complete Tasks").Cells(Lastrow, 1)
Rows(r).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
It's very simple you have to define a new range without the last column for the row.
Your code may be like this:
(Cell2Copy is the new range to copy )
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell2Copy as Range
Dim r As Long
Dim Lastrow As Long
If Target.Column = 9 Then
Application.EnableEvents = False
r = Target.Row
Lastrow = Sheets("Tasks").Cells(Rows.Count, "I").End(xlUp).Row + 1
If Target.Value = "Complete" Then
set Cell2Copy = Rows(r).Cells(1,Columns.count-1)
Cell2Copy.Copy Sheets("Complete Tasks").Cells(Lastrow, 1)
Rows(r).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
Have a good day.
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
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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long
lastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
ActiveSheet.Unprotect
lastRow.Locked = True
ActiveSheet.Protect
End Sub
*I already run this code. But still not lock the last row.
*When add "MsgBox lastrow" its working and show correct selected row.
*Thank You
Open This For More Info ----> Excel View With Msg Box
In case your cell in Column E is part of a merged cells (in your case Columns E:K are merged), then you set a new Range with the variable MergedCell to the merged area, and then Lock the entire range of merged cells.
Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, cell As Range, MergedCell As Range
' find last row in Column E
lastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
ActiveSheet.Unprotect
Set cell = Range("E" & lastRow)
' if cell in Column E is part of merged cells
If cell.MergeCells = True Then
Set MergedCell = cell.MergeArea
MergedCell.Locked = True
Else
cell.Locked = True
End If
ActiveSheet.Protect
End Sub