View Full Version : Solved: Cut and Paste Value to matching Column
Emoncada
02-24-2012, 11:06 AM
I have a spreadsheet with Column headers from B1:Y1.
in A1 I have an embedded ComboBox with a list of names in the headers.
I want to be able to scan or enter a Value in A2 and Afterupdate, cut that value and move it to it's column based on A1. Then have it stay in A2 for another entry.
Can this be done?
shrivallabha
02-25-2012, 07:25 AM
Right click on Sheet's tab and choose "View Code" then paste this code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Address = "$A$2" And Target.Value <> "" Then
Set r = Range("B1:K1").Find(What:=Range("A1").Value, LookIn:=xlValues, Lookat:=xlWhole)
Target.Cut Destination:=Cells(2, r.Column)
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Emoncada
02-26-2012, 08:40 AM
I haven't tested yet, but would this continue to put information down a column like a list if A1 is the same? Or this just places it in row 2 for that column?
shrivallabha
02-26-2012, 09:07 AM
Yes that is correct, the data goes in row 2.
So you want to paste the data into new row every time you make changes in A2. Is this correct?
Then this should work out:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Address = "$A$2" And Target.Value <> "" Then
Set r = Range("B1:K1").Find(What:=Range("A1").Value, LookIn:=xlValues, Lookat:=xlWhole)
Target.Cut Destination:=Cells(Cells(Rows.Count, r.Column).End(xlUp)(2).Row, r.Column)
Range("A2").Select
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Emoncada
02-27-2012, 10:45 AM
shrivallabha I appreciate your help. It's working, but after further testing I am getting a Run-time error '13' Type Mismatch when i select 2 cells and delete.
It's taking me to
If Target.Address = "$A$2" And Target.Value <> "" Then
shrivallabha
02-27-2012, 11:04 AM
OK. I had not considered any error handling in the routine. Now this should take care of it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo EOSub
If Target.Address = "$A$2" And Target.Value <> "" Then
Set r = Range("B1:K1").Find(What:=Range("A1").Value, LookIn:=xlValues, Lookat:=xlWhole)
Target.Cut Destination:=Cells(Cells(Rows.Count, r.Column).End(xlUp)(2).Row, r.Column)
Range("A2").Select
End If
EOSub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Emoncada
02-27-2012, 11:25 AM
Perfect Thank you Shrivallabha!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.