mperrah
09-01-2007, 06:38 PM
I'm trying to auto update a list of tech names and ID numbers (2 columns)
when ever a new tech is added to a source sheet, I need to copy and past it to a techlist sheet and sort (name and ID) keeping the name and id linked
I found a code to paste 1 column and sort,
I modified the code to sort both columns,
I'm having trouble seeing how to update both columns (paste 2 columns for sorting).
Also the source sheet has a datavalidation list as the target,
I either need to make this dv copy all the way down the page for the code to work,
or find a way to make the code work without the dataval cell.
I'm not sure if the code can be altered so the dv is not necessary.
The source sheet gives you the option of clicking a drop down list to change the value in the source cell, I don't need this option.
I have a macro that pastes data to the source sheet and I will not change it after that.
The pasted data just needs to be scanned for new unique values and add the unique values to the archive list and sort it by tech ID.
This is the code on the source sheet (QCDetail):
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")
End If
End If
End Sub
here is the archive sheet (wqc) that sorts the 2 columns:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Range("techarray").Select
ActiveWorkbook.Worksheets("wqc").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("wqc").Sort.SortFields.Add _
Key:=Range("techid"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("wqc").Sort
.SetRange Range("techarray")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
the techID range is named :
=OFFSET(wqc!$B$1,0,0,COUNTA(wqc!$B:$B),1)
the tech name range is named:
=OFFSET(wqc!$A$1,0,0,COUNTA(wqc!$A:$A),1)
the techname and id array is named:
=techarray
I've attached the file.
Thanks in advance
Mark
when ever a new tech is added to a source sheet, I need to copy and past it to a techlist sheet and sort (name and ID) keeping the name and id linked
I found a code to paste 1 column and sort,
I modified the code to sort both columns,
I'm having trouble seeing how to update both columns (paste 2 columns for sorting).
Also the source sheet has a datavalidation list as the target,
I either need to make this dv copy all the way down the page for the code to work,
or find a way to make the code work without the dataval cell.
I'm not sure if the code can be altered so the dv is not necessary.
The source sheet gives you the option of clicking a drop down list to change the value in the source cell, I don't need this option.
I have a macro that pastes data to the source sheet and I will not change it after that.
The pasted data just needs to be scanned for new unique values and add the unique values to the archive list and sort it by tech ID.
This is the code on the source sheet (QCDetail):
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")
End If
End If
End Sub
here is the archive sheet (wqc) that sorts the 2 columns:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Range("techarray").Select
ActiveWorkbook.Worksheets("wqc").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("wqc").Sort.SortFields.Add _
Key:=Range("techid"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("wqc").Sort
.SetRange Range("techarray")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
the techID range is named :
=OFFSET(wqc!$B$1,0,0,COUNTA(wqc!$B:$B),1)
the tech name range is named:
=OFFSET(wqc!$A$1,0,0,COUNTA(wqc!$A:$A),1)
the techname and id array is named:
=techarray
I've attached the file.
Thanks in advance
Mark