vonsnapper
New Member
- Joined
- Mar 15, 2018
- Messages
- 12
So I'm trying to write some code that would allow a person to select an item off a list and then excel will automatically copy the contents of the selected cell and the adjacent cell (which contains the supply code for the item) and then automatically paste them into two new cells. This will allow me build a smaller list of things (from the large list) that I want to order for work. If I don't use the code in Bold it will automatically select both cell I click on plus the adjacent one and copy them. It will not paste them however and I must do it manually (which is much better then typing the list every week) however it would be even better if excel would automatically paste them as well. If I add the code in bold...well I had to shut excel down and restart it froze things up so bad. Any thoughts or ideas would be greatly appreciated.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
With ActiveCell
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Range(Cells(.Row, .CurrentRegion.Column), _
Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)) _
.Interior.Color = vbCyan And Selection.Copy
End With
Application.ScreenUpdating = True
End Sub
<strike></strike>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
With ActiveCell
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Range(Cells(.Row, .CurrentRegion.Column), _
Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)) _
.Interior.Color = vbCyan And Selection.Copy
Range("J5").Select
If IsEmpty(Target) Then
ActiveSheet.Paste
Else
Target.Offset(1, 0) = ActiveSheet.Paste
End If
<strike style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; line-height: normal; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; orphans: 2; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; word-spacing: 0px;"></strike>If IsEmpty(Target) Then
ActiveSheet.Paste
Else
Target.Offset(1, 0) = ActiveSheet.Paste
End If
End With
Application.ScreenUpdating = True
End Sub
<strike></strike>
