I have the following code to insert a new row based on the cell value. How can I modify this to also copy the value in column A for example) to the newly inserted row?
Private Sub Worksheet_Change(ByVal Target As Range)
Set Rng = Range("B11:B50")
If Target.Count = 1 Then
If Target.Value = "Annual" Then
If Not Intersect(Target, Rng) Is Nothing Then
Application.EnableEvents = False
Target(1).Offset(1, 0).EntireRow.Insert Shift:=xlDown
Application.EnableEvents = True
End If
End If
End If
End Sub
Cells(Target.Row + 1, 1).Value = Cells(Target.Row, 1).Value
To copy both A & B
Cells(Target.Row + 1, 1).Value = Cells(Target.Row, 1).Value
Cells(Target.Row + 1, 2).Value = Cells(Target.Row, 2).Value
Related
Please can you advise how I tweak the below code to only move row data for columns A:H?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
If Target = "Complete" Then
nxtRw = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy Sheets("Completed").Range("A" & nxtRw)
Application.EnableEvents = False
Target.EntireRow.Delete shift:=xlUp
Application.EnableEvents = True
ElseIf Target.Column = 11 Then
If Target = "Cancelled" Then
nxtRw = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy Sheets("Completed").Range("A" & nxtRw)
Application.EnableEvents = False
Target.EntireRow.Delete shift:=xlUp
Application.EnableEvents = True
End If
End If
End If
End Sub
At the moment it moves the whole row over. in the sheet it moves to I have additional validation lists in rows I,J,K which it removes when it copies over.
Any help is much appreciated
thanks
Matt
Use the Resize property. You can also shorten your If slightly.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
If Target = "Complete" Then
nxtRw = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(Target.Row, 1).Resize(, 8).Copy Sheets("Completed").Range("A" & nxtRw)
Application.EnableEvents = False
Target.EntireRow.Delete shift:=xlUp
Application.EnableEvents = True
ElseIf Target = "Cancelled" Then
nxtRw = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(Target.Row, 1).Resize(, 8).Copy Sheets("Completed").Range("A" & nxtRw)
Application.EnableEvents = False
Target.EntireRow.Delete shift:=xlUp
Application.EnableEvents = True
End If
End If
End Sub
The macro that follows works alright if I put it in sheet1. However I would like to put this macro in sheet2. Unfortunately it doesn't make the job from sheet2, only from Sheet1. Can you please help me to make it run from Sheet2?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim sRes As Variant
On Error GoTo haveError
Set rng = Application.Intersect(Sheet1.Range("I15:I18"), Target)
If Not rng Is Nothing Then
If rng.Cells.count = 1 Then
sRes = Application.VLookup(rng.Value, _
Sheet2.Range("A56:B58"), 2, True)
'turn off events before updating the worksheet
Application.EnableEvents = False
rng.Offset(0, 1).Value = IIf(IsError(sRes), "???", sRes)
Select Case rng.Offset(0, 1).Value
Case "Low Risk": rng.Offset(0, 2).Value = Date + 180
Case "Medium Risk": rng.Offset(0, 2).Value = Date + 150
Case "High Risk": rng.Offset(0, 2).Value = Date + 120
End Select
Application.EnableEvents = True
End If '<< edit added missing line here
End If
Exit Sub
haveError:
Application.EnableEvents = True '<< ensures events are reset
End Sub
The answer to this question it is simpler than I thought:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rng1 As Range
Dim sRes As Variant
Dim sRes1 As Variant
On Error GoTo haveError
Set rng = Application.Intersect(Sheet1.Range("I15:I18"), Target)
Set rng1 = Application.Intersect(Sheet1.Range("I20:I23"), Target)
If Not rng Is Nothing Then
If rng.Cells.count = 1 Then
sRes = Application.VLookup(rng.Value, _
Sheet2.Range("A56:B58"), 2, True) 'Waterlow
'turn off events before updating the worksheet
Application.EnableEvents = False
rng.Offset(0, 1).Value = IIf(IsError(sRes), "???", sRes)
Select Case rng.Offset(0, 1).Value
Case "Low Risk": rng.Offset(0, 2).Value = Date + 180
Case "Medium Risk": rng.Offset(0, 2).Value = Date + 150
Case "High Risk": rng.Offset(0, 2).Value = Date + 120
End Select
Application.EnableEvents = True
End If '<< edit added missing line here
ElseIf Not rng1 Is Nothing Then
If rng1.Cells.count = 1 Then
sRes1 = Application.VLookup(rng1.Value, _
Sheet3.Range("A28:B30"), 2, True) 'MUST
'turn off events before updating the worksheet
Application.EnableEvents = False
rng1.Offset(0, 1).Value = IIf(IsError(sRes1), "???", sRes1)
Select Case rng1.Offset(0, 1).Value
Case "Low Risk": rng1.Offset(0, 2).Value = Date + 180
Case "Medium Risk": rng1.Offset(0, 2).Value = Date + 150
Case "High Risk": rng1.Offset(0, 2).Value = Date + 120
End Select
Application.EnableEvents = True
End If '<< edit added missing line here
End If
Exit Sub
haveError:
Application.EnableEvents = True '<< ensures events are reset
End Sub
It is only a matter to combine two procedures. A simple Elseif make it run (work :)) the macro.
Thanks to all of you for trying to help me.
So currently I am trying to come up with a if statement. Basically if A3 has any text value I want it to equal awesome. I want to loop this command with the last column in mind.
Sub Criteria
If Range("A2") = "Feedback" And Range("A3") = "**" Then
Range("A1") = "Awesome"
Else
Range("A1") = ""
End If
End sub
(This is the code I came up with can someone help me make it cleaner/faster)
Sub Status()
lastrow = Rows(Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, 1) = "Onsite" And Not IsEmpty(Cells(i, 2)) Then
Cells(i, 3) = "Feedback"
Else
If Cells(i, 1) = "Phone" And Not IsEmpty(Cells(i, 2)) Then
Cells(i, 3) = "Feedback"
Else
If Cells(i, 1) = "Phone" And IsEmpty(Cells(i, 2)) Then
Cells(i, 3) = "Pending Next Step"
Else
If Cells(i, 1) = "Onsite" And IsEmpty(Cells(i, 2)) Then
Cells(i, 3) = "Pending Decision"
End If
End If
End If
End If
Next i
End Sub
Try using Option Explicit also set your worksheet so your not running the code on wrong sheet or to avoid a error
Option Explicit
Public Sub Status()
Dim Sht As Worksheet
Dim rng As Range
Set Sht = ThisWorkbook.Sheets("Sheet1")
For Each rng In Sht.Range("A2", Sht.Range("A9999").End(xlUp))
Debug.Print rng.Address ' print on immed win
DoEvents ' For Debuging
If rng.Value = "Onsite" And rng.Offset(0, 1).Value > 0 Then
rng.Offset(0, 2).Value = "Feedback"
ElseIf rng.Value = "Onsite" And rng.Offset(0, 1).Value = "" Then
rng.Offset(0, 2).Value = "Pending Decision"
End If
If rng.Value = "Phone" And rng.Offset(0, 1).Value > 0 Then
rng.Offset(0, 2).Value = "Feedback"
ElseIf rng.Value = "Phone" And rng.Offset(0, 1).Value = "" Then
rng.Offset(0, 2).Value = "Pending Next Step"
End If
Next
Set Sht = Nothing
Set rng = Nothing
End Sub
Range.Offset Property (Excel)
Syntax: expression.Offset(RowOffset, ColumnOffset)
Returns a Range object that represents a range that?s offset from the specified range.
I have just started using VBA and have learned how to change columns using change event handlers - but I can't get it to work when I need to change rows as well. Based on a response in one cell i.e "Yes" or "No" - I want to populate other cells with "N/A" or blank.
I have got this to work for one row but I now need to put "N/A" on other rows as well. Could someone please help. My code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I6:I7")) Is Nothing Then
If Cells(Target.Row, 9) = "Manual" Then
Cells(Target.Row, 10) = "N/A"
Cells(Target.Row, 11) = "N/A"
'**Cells(8, 11) = "N/A"**
ElseIf Cells(Target.Row, 9) = "Depalletiser" Then
Cells(Target.Row, 10) = ""
Cells(Target.Row, 11) = ""
ElseIf Cells(Target.Row, 9) = "Robot" Then
Cells(Target.Row, 10) = ""
Cells(Target.Row, 11) = ""
End If
End If
End Sub
summing up the suggestions you already received with comments and throwing in some new points, you could consider this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I6:I7")) Is Nothing Then
Application.EnableEvents = False '<-- best practice: avoid subsequent possible worksheet changes trigger this event again and again in an infinite loop
On Error GoTo ExitSub '<--best practice: be sure to get and enable events should any error cause the end of this sub
Select Case Cells(Target.Row, 9).Value
Case "Manual"
Target.Offset(, 1).Resize(, 2) = "N/A"
Case "Depalletiser", "Robot"
Target.Offset(, 1).Resize(, 2).ClearContents
End Select
End If
ExitSub:
Application.EnableEvents = True
End Sub
You could use Offset
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(Target.Row, Target.Column).Offset(rowOffset:=3, columnOffset:=0) _
.Value = "I'm beneath you :-o"
Columns(Target.Column).AutoFit
End Sub
I have a strange issue, I have a sheet in excel 2013 which uses the doubleclick to select a cell( which has some text in it that I want locked so the user does not change), change the text colour to highlight the chosen cell and then put a value based on the target.column in a cell further along the row.
It works fine if I unlock the sheet but all attempts to lock the sheet end up with a error in the value of "Target.row" I put the msg statement in and I can see that at the end of each call the active cell then moves to the next unlocked cell and wont then move/update the values when you next click on a wanted cell to highlight.
I have tried all sorts of fixes for this and made many code changes. Currently the code is:
Private Sub Workbook_Open()
' protect worksheets but allow macros
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect Password:="Purple15", userinterfaceonly:=True
Next ws
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Sheet3.Protect Password:="Purple15", UserInterFaceOnly:=True
Dim i As Integer
Dim d As Integer
MsgBox " row is " & Target.Row & " col is " & Target.Column
'Cells(Target.Row, 1).Value = "S"
For d = 1 To 1000
Next d
' above just slows it down to see effect
Sheet3.Unprotect Password:="Purple15"
'Cells(Target.Row, 1).Value = "U"
' check if double click is in the range cols 9 to 13 as these are the only ones they should choose
' if so then set font colour to red for the chosen cell and put chosen col number in col 16 for the sheet to then pick up from
'Cells(5, 1).Value = "U"
If Target.Column >= 9 And Target.Column <= 13 Then
'Cells(Target.Row, 1).Value = 2
Cells(Target.Row, 9).Font.Color = vbBlack
Cells(Target.Row, 10).Font.Color = vbBlack
Cells(Target.Row, 11).Font.Color = vbBlack
Cells(Target.Row, 12).Font.Color = vbBlack
Cells(Target.Row, 13).Font.Color = vbBlack
Target.Font.Color = vbRed
Cells(Target.Row, 16) = (Target.Column)
' also check if the double click is in the reset box, if so then reset all the values in col 16 to the starting condition of 9
ElseIf Target.Column = 2 And Target.Row = 3 Then
'Cells(3, 1).Value = 3
For i = 8 To 300
Cells(i, 1).Value = " "
Cells(i, 9).Font.Color = vbBlack
Cells(i, 10).Font.Color = vbBlack
Cells(i, 11).Font.Color = vbBlack
Cells(i, 12).Font.Color = vbBlack
Cells(i, 13).Font.Color = vbBlack
If Cells(i, 16).Value >= 10 Then Cells(i, 16).Value = 9
Next i
Else
End If
'Cells(5, 1).Value = " "
'Cancel = True
Sheet3.Protect Password:="Purple15", userinterfaceonly:=True
'Cells(5, 1).Value = "L"
End Sub
You may want to look into using buttons. That way you don't have to worry about end-users changing values (as easily). I created a spreadsheet with only one row and "SomeText 1" in column A, "SomeText 2" in column B and "SomeText 3" in column C. Below is the code and I think it is working as you expect.
In "ThisWorkbook" I used your exact code:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect Password:="Purple15", userinterfaceonly:=True
Next ws
End Sub
In "Sheet1" I used this:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column >= 1 And Target.Column <= 3 Then
'Reset all of the "Buttons" to black
Cells(Target.Row, 1).Font.Color = vbBlack
Cells(Target.Row, 2).Font.Color = vbBlack
Cells(Target.Row, 3).Font.Color = vbBlack
'Makes the one they clicked red
Target.Font.Color = vbRed
'Change focus so you don't get the "Protected Worksheet"
' warning after a double-click
Cells(Target.Row, 6).Select
'Unlock the cell you're editing
Cells(Target.Row, 6).Locked = False
'Set the cell's value
Cells(Target.Row, 6) = (Target.Column)
'Lock it again
Cells(Target.Row, 6).Locked = True
End If
End Sub
Is that what you are looking for?