mperrah
08-28-2007, 12:03 AM
I found this code in contextures that sorts a column ass soon as you hit enter.
I have 2 columns (a and b) starting at row 4 that I need to sort together after the second row is input
For example, A1 is paired with B1, but is alphabetical ordered to A5 so B1 needs to move to B5 to stay in the row with the previous paired data
If I can make a variable to assign the change the first set of data moves and re-apply it to the second set, I think we have it, not sure how to get there.
This is what I have.
This is on the datavalidation sheet
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("WQC")
If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
Set rng = ws.Range(Cells(1, Target.Column) & "List")
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
Set rng = ws.Range(Cells(1, Target.Column) & "List")
rng.Sort Key1:=ws.Cells(1, rng.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
End Sub
This is on the list sheet
'Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Columns(Target.Column).Sort Key1:=Cells(1, Target.Column), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Original file attached.
Thank you for your expertise.
Mark
I have 2 columns (a and b) starting at row 4 that I need to sort together after the second row is input
For example, A1 is paired with B1, but is alphabetical ordered to A5 so B1 needs to move to B5 to stay in the row with the previous paired data
If I can make a variable to assign the change the first set of data moves and re-apply it to the second set, I think we have it, not sure how to get there.
This is what I have.
This is on the datavalidation sheet
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("WQC")
If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
Set rng = ws.Range(Cells(1, Target.Column) & "List")
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
Set rng = ws.Range(Cells(1, Target.Column) & "List")
rng.Sort Key1:=ws.Cells(1, rng.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
End Sub
This is on the list sheet
'Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Columns(Target.Column).Sort Key1:=Cells(1, Target.Column), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Original file attached.
Thank you for your expertise.
Mark