Macro to copy and insert

Hi, im super rubbish at writing macros and i was hoping an expert here could help

I need a macro so that when i type a number in a cell P6 and press enter, it copies that number, clears the cell P6, and inserts it in R6, pushing all the prior numbers i have in the row (R6,R7,R8 etc) to the right. I require this macro so that i dont have to manually copy, insert, and choose 'shift cells right' from the insert option, as im constantly updating cell P6 throughout the day with a new value.

I actually have to update the entire column P with new values during the day, so i would require this work down the whole column, inserting in the corresponding cell into column R (P6 to R6, P7 to R7 etc...)

Appreciate if someone could help.... Going to make my life at work alot easier!!

Thnx

You could use this code (to apply it right click on the bottom sheet name and choose view code).

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count = 1 And Target.Column = 16 Then
      Target.Offset(, 2) = Target
      Application.EnableEvents = False
      Target = ""
      Application.EnableEvents = True
   End If
End Sub

Regards,
Antonio

Thanks Antonio..

I already have another macro for the page working in the background for something else, so adding this macro i get the following error message:

Compile error:

Ambiguous name detected: Worksheet _Change

Should i change it to something else, like Worksheet _Change2? ie

Private Sub Worksheet_Change(ByVal Target As Range)

thnx

Paste this code:

   If Target.Cells.Count = 1 And Target.Column = 16 Then
      Target.Offset(, 2) = Target
      Application.EnableEvents = False
      Target = ""
      Application.EnableEvents = True
   End If

Below the row:

Private Sub Worksheet_Change(ByVal Target As Range)

and above the row:

End Sub

Regards,
Antonio

i see! great, that fits in now, however its just pasting the value into cell R6, not 'inserting' it, so that the previous value in R6 moves to the right, thus keeping all the previuous values in R6 nicely in Row 6... if that makes sense.

I need to insert it so it doesnt copy over the previous value. i need to keep a record....

thnx

Please change the previous code with this:

   Dim lastCol As Integer, myRow As Long
   If Target.Cells.Count = 1 And Target.Column = 16 Then
      myRow = Target.Row
      Application.EnableEvents = False
      With ThisWorkbook.ActiveSheet
         lastCol = .Cells(myRow, Columns.Count).End(xlToLeft).Column
         If lastCol >= 18 Then
            .Cells(myRow, 18).Resize(, lastCol - 17).Copy .Cells(myRow, 19)
         End If
      End With
      Target.Offset(, 2) = Target
      Target = ""
      Application.EnableEvents = True
   End If

Regards,
Antonio

Thanks Antonio... we're getting close!

I have a previous macro (mentioned before) to turn text 'd100' into a '<downarrow>100' in red text, and 'u100' into '<uparrow>100' in green text. red for down, green for up.

The macro for that is:

If Target.Count > 1 Then Exit Sub
If Intersect(Target, [R6:AT96]) Is Nothing Then Exit Sub
If Not Target Like "[ud]*" Then Target.font.Name = "Arial": Target.font.Color = vbBlack: Exit Sub
Application.EnableEvents = False
Target.font.Name = "Arial"
With Target.Characters(1, 1)
    .font.Name = "Marlett"
    .Text = IIf(.Text = "u", "t", "u")
    Target.font.Color = IIf(.Text = "u", vbRed, vbGreen)
End With
Application.EnableEvents = True

So,

Including your macro into this Worksheet_Change, it now doesnt change the value 'd100' to '<downarrow>100' in red in the new cell R6, and vice versa in green..


Here's the whole macro so you can test it your side :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastCol As Integer, myRow As Long
   If Target.Cells.Count = 1 And Target.Column = 16 Then
      myRow = Target.Row
      Application.EnableEvents = False
      With ThisWorkbook.ActiveSheet
         lastCol = .Cells(myRow, Columns.Count).End(xlToLeft).Column
         If lastCol >= 18 Then
            .Cells(myRow, 18).Resize(, lastCol - 17).Copy .Cells(myRow, 19)
         End If
      End With
      Target.Offset(, 2) = Target
      Target = ""
      Application.EnableEvents = True
   End If
   
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [R6:AJ43]) Is Nothing Then Exit Sub
If Not Target Like "[ud]*" Then Target.font.Name = "Arial": Target.font.Color = vbBlack: Exit Sub
Application.EnableEvents = False
Target.font.Name = "Arial"
With Target.Characters(1, 1)
    .font.Name = "Marlett"
    .Text = IIf(.Text = "u", "t", "u")
    Target.font.Color = IIf(.Text = "u", vbRed, vbGreen)
End With
Application.EnableEvents = True
End Sub

As you can see, your macro is working, value 'u100' from P6 gets inserted into R6 when pressing enter, but it doesn't change to an '<uparrow>100' in green text anymore. A workaround is to just double clicking R6, and hit enter. This executes it, and it changes.

Is there a way to automate this though, so it does everything at once??

That should be all then!

Thanks so much for you help on this....

This code should do what you need:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim lastCol As Integer, myRow As Long
   Dim myRange As Range
   
   If Target.Count > 1 Then Exit Sub
   
   Set myRange = Target
   If Target.Column = 16 Then
      myRow = Target.Row
      Application.EnableEvents = False
      With ThisWorkbook.ActiveSheet
         lastCol = .Cells(myRow, Columns.Count).End(xlToLeft).Column
         If lastCol >= 18 Then
            .Cells(myRow, 18).Resize(, lastCol - 17).Copy .Cells(myRow, 19)
         End If
      End With
      Target.Offset(, 2) = Target
      Target = ""
      Application.EnableEvents = True
      Set myRange = Target.Offset(, 2)
   End If
   
   If Intersect(myRange, [R6:AJ43]) Is Nothing Then Exit Sub
   If Not myRange Like "[ud]*" Then myRange.Font.Name = "Arial": myRange.Font.Color = vbBlack: Exit Sub
   Application.EnableEvents = False
   myRange.Font.Name = "Arial"
   With myRange.Characters(1, 1)
      .Font.Name = "Marlett"
      .Text = IIf(.Text = "u", "t", "u")
      myRange.Font.Color = IIf(.Text = "u", vbRed, vbGreen)
   End With
   Application.EnableEvents = True
End Sub

Regards,
Antonio

That's awesome, thank you so much...

Just for my reference (and macro learning curve!!), if i need to delete a column or two below R, which numbers do i change in the code? I've played around with it but can't get it to change.

Let's say i want to delete columns L, M, N and Q?

Thanks again