When the word "Overdue" appears in a cell (in column H), I want the name (in column A) and the date (in column F) in that row to automatically copy and paste into another worksheet (named HomePage) and appear in column C12 and E12.
I have the following code, but it's cutting and pasting the entire row. I just want a copy and paste of the name and date to my HomePage.
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Column = 8 Then
If Target.Value = "Overdue" Then
R = Target.Row
Rows(R).Cut
Worksheets("HomePage").Select
With ActiveSheet
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
.Cells(lastrow, 1).Select
.Paste
End With
End If
End If
End Sub
Since you only want two cells, why copy and paste? Just assign the values directly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long
If Target.Column = 8 Then
If Target.Value = "Overdue" Then
With Sheets("Homepage")
R = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(R, 3) = Target.Offset(0, -7) ' Column C = Column A
.Cells(R, 5) = Target.Offset(0, -2) ' Column E = Column F
End With
End If
End If
End Sub
as per your narrative
I want the name (in column A) and the date (in column F) in that row
to automatically copy and paste into another worksheet (named
HomePage) and appear in column C12 and E12.
place the following code in your worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column = 8 And .Value = "Overdue" Then
Sheets("Homepage").Range("C12").Value = Range(.row, "A")
Sheets("Homepage").Range("E12").Value = Range(.row, "F")
End If
End With
End Sub
Related
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
My VBA is not running once a cell data is changed.
On my worksheet I have VBA running in Column F and G.
Column G has data validation that I want to trigger based on the numerical value input in column F.
Example:
Column F has a numerical value of 2.5 which results in Column G displaying "Good Standing".
If I change the Column F value to < 2, I want Column G cell to show blank
and vice versa if Column F value is originally < 2, and I increase it to > 2 Column G will display "Good Standing.
Private Sub Worksheet_Change(ByVal Target As Range)
StrtRow = 2
EndRow = Range("F" & Rows.Count).End(xlUp).Row
For i = StrtRow To EndRow
If Range("F" & i).Value >= 2 Then
Range("G" & i).Value = "Good Standing"
End If
Next
End Sub
You're missing an Else clause to clear the contents if < 2. Taking #SJR 's comment into account, try this (not tested)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngWatched As Range: Set rngWatched = Me.Range("F:F")
Dim cl As Range
If Not Intersect(rngWatched, Target) Is Nothing Then
Application.EnableEvents = False
For Each cl In Intersect(rngWatched, Target)
If cl.Value >= 2 Then
cl.Offset(0, 1).Value = "Good Standing"
Else
cl.Offset(0, 1).ClearContents
End If
Next
Application.EnableEvents = True
End If
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
I have the following spreadsheet. When ever there is an x in cell B I need to populate the d and e cells in the same row using an equation I have.
if there is no x in the b cell I need to manually enter values into cells d & e.
How do I make my code non-row specific?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim val As String
val = Range("B3").Value
If val = "x" Then
Range("E3").Value = Range("d2").Value * Range("G2").Value
Range("D3").Value = Range("D2").Value
End If
End Sub
I'm not sure if I understand correctly, but if you have a parameter: row = 3 you can use Range("E" & row) instead of Range("E3").
Put a loop around that where you vary 'row' for the rows you want to modify.
Hope that helps!
You've created a sub procedure around the Worksheet_SelectionChange event. In fact, you require Worksheet_Change and you need to,
disable event handling so you can write new values/formulas to the worksheet without running the Worksheet_Change on top of itself.
loop through each matching cell in Target to compensate for circumstances when Target can be more than a single cell,
add error control.
Rewrite:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
If LCase(t.Value) = "x" Then
'I've made these formulas relative to each target
'you may want to make some absolute references
t.Offset(0, 3) = t.Offset(-1, 2) * t.Offset(-1, 5)
t.Offset(0, 2) = t.Offset(-1, 2)
Else
t.Offset(0, 2).resize(1, 2) = vbnullstring
End If
Next t
End If
safe_exit:
Application.EnableEvents = True
End Sub
Please try below code.
It loop through all non empty rows in column B and check if there is value: x
If so it populate your formulas.
Sub new_sub()
' get last_row of data
last_row = ActiveSheet.UsedRange.Rows.Count
' loop through all rows with data and check if in column B any cell contains value: x
For i = 1 To last_row
' if there is any cell with value: x
' then add below formulas
If Cells(i, 2).Value = "x" Then
' for column E: take value from row above for col D and G and multiple
Range("E" & i).Value = Range("d" & i - 1).Value * Range("G" & i - 1).Value
' for column D: take value from row above
Range("D" & i).Value = Range("D" & i - 1).Value
End If
Next i
End Sub