S
Sinner
I have the following code for deleting pins found in a list in
"column
1" of "sheet1" from list in "column 1" of "sheet 2" with the list
tagged in other columns, leaving behind updated & reconciled dataset
in sheet 2.
Format of "sheet 1" is like:
1100000086125125778
1100000086125125779
1100000086125125782
Format of "sheet 2" is like:
1100000086125125778 KANSAS NORTH
MARKED 441
1100000086125125779 KANSAS NORTH
MARKED 443
1100000086125125780 PARIS CENTRAL
MARKED 442
1100000086125125781 KOREA SOUTH
MARKED 441
1100000086125125782 NEPAL NORTH-II
MARKED 441
The updated record set after the script is run should be like:
1100000086125125780 PARIS CENTRAL
MARKED 442
1100000086125125781 KOREA SOUTH
MARKED 441
which I can carry forward for next term.
The pins however are more than 11 characters long i.e. 19 to 20
characters. e.g. 1100000086125125778, 1100000086125125779,
1100000086125125780 and so on.
First 8 to 9 are common characters in the list so I trim them to 11
to
make my lists for further processing. After I have the updated
dataset
of the list, I add the common starting characters back.
Any suggestions?
Secondly, I would like the script to auto sort the lists in both the
sheets in ascending order before deletion BUT as there are multiple
columns in "sheet 2" with tags in other columns, we need to sort that
sheet so that it does not disturb the column order in the adjacent
column (like sort option from autofilter where the column/row data
integrity is not compromised).
CODE is as follows:
--------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------
Dim rngeSht1 As Range
Dim rngeSht2 As Range
Dim PinNumber
Dim Serial
Dim NameToFind
Dim Y
Sub Delete_Rows()
Sheets("Sheet1").Select
'Insert a column to left of data on sheet 1
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
'Set this to a range as column 1 and to include all rows
Set rngeSht1 = Worksheets("Sheet1").Range("A1", Cells(Rows.Count,
1))
'Each value trimmed of superflourous leading and trailing spaces
For Each Serial In rngeSht1
PinNumber = Trim(Serial.Offset(0, 1).Range("A1"))
Serial.Value = PinNumber
If Serial.Value = "" Then
Exit For 'Exit when run out of data
End If
Next Serial
Sheets("Sheet2").Select
'Insert a column to left of data on sheet 2
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
'Set this to a range as column 1 and to include all rows
Set rngeSht2 = Worksheets("Sheet2").Range("A1", Cells(Rows.Count,
1))
'Concatonate all the values in cells and place in one cell
'Each value trimmed of superflourous leading and trailing spaces
For Each Serial In rngeSht2
PinNumber = Trim(Serial.Offset(0, 1).Range("A1"))
Serial.Value = PinNumber
If Serial.Value = "" Then
Exit For 'Exit when run out of data
End If
Next Serial
'For each value in sheet 1, find corresponding value
'in sheet 2 and if found, delete entirerow.
For Each Serial In rngeSht1
If Serial.Value = "" Then
Exit For 'Exit when run out of data to find
End If
NameToFind = Serial.Value
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns
_
, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
If Not Y Is Nothing Then 'Y Not Nothing = Found target
Do
Y.EntireRow.Delete
'NOTE: FindNext does not work when a row from the
range
'has been deleted. Must repeat full find method
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole,
SearchOrder:=xlByColumns _
, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
Loop While Not Y Is Nothing
End If
Next Serial
Sheets("Sheet1").Select
Columns("A:A").Delete
Range("A1").Select
Sheets("Sheet2").Select
Columns("A:A").Delete
Range("A1").Select
End Sub
--------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------
"column
1" of "sheet1" from list in "column 1" of "sheet 2" with the list
tagged in other columns, leaving behind updated & reconciled dataset
in sheet 2.
Format of "sheet 1" is like:
1100000086125125778
1100000086125125779
1100000086125125782
Format of "sheet 2" is like:
1100000086125125778 KANSAS NORTH
MARKED 441
1100000086125125779 KANSAS NORTH
MARKED 443
1100000086125125780 PARIS CENTRAL
MARKED 442
1100000086125125781 KOREA SOUTH
MARKED 441
1100000086125125782 NEPAL NORTH-II
MARKED 441
The updated record set after the script is run should be like:
1100000086125125780 PARIS CENTRAL
MARKED 442
1100000086125125781 KOREA SOUTH
MARKED 441
which I can carry forward for next term.
The pins however are more than 11 characters long i.e. 19 to 20
characters. e.g. 1100000086125125778, 1100000086125125779,
1100000086125125780 and so on.
First 8 to 9 are common characters in the list so I trim them to 11
to
make my lists for further processing. After I have the updated
dataset
of the list, I add the common starting characters back.
Any suggestions?
Secondly, I would like the script to auto sort the lists in both the
sheets in ascending order before deletion BUT as there are multiple
columns in "sheet 2" with tags in other columns, we need to sort that
sheet so that it does not disturb the column order in the adjacent
column (like sort option from autofilter where the column/row data
integrity is not compromised).
CODE is as follows:
--------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------
Dim rngeSht1 As Range
Dim rngeSht2 As Range
Dim PinNumber
Dim Serial
Dim NameToFind
Dim Y
Sub Delete_Rows()
Sheets("Sheet1").Select
'Insert a column to left of data on sheet 1
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
'Set this to a range as column 1 and to include all rows
Set rngeSht1 = Worksheets("Sheet1").Range("A1", Cells(Rows.Count,
1))
'Each value trimmed of superflourous leading and trailing spaces
For Each Serial In rngeSht1
PinNumber = Trim(Serial.Offset(0, 1).Range("A1"))
Serial.Value = PinNumber
If Serial.Value = "" Then
Exit For 'Exit when run out of data
End If
Next Serial
Sheets("Sheet2").Select
'Insert a column to left of data on sheet 2
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
'Set this to a range as column 1 and to include all rows
Set rngeSht2 = Worksheets("Sheet2").Range("A1", Cells(Rows.Count,
1))
'Concatonate all the values in cells and place in one cell
'Each value trimmed of superflourous leading and trailing spaces
For Each Serial In rngeSht2
PinNumber = Trim(Serial.Offset(0, 1).Range("A1"))
Serial.Value = PinNumber
If Serial.Value = "" Then
Exit For 'Exit when run out of data
End If
Next Serial
'For each value in sheet 1, find corresponding value
'in sheet 2 and if found, delete entirerow.
For Each Serial In rngeSht1
If Serial.Value = "" Then
Exit For 'Exit when run out of data to find
End If
NameToFind = Serial.Value
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns
_
, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
If Not Y Is Nothing Then 'Y Not Nothing = Found target
Do
Y.EntireRow.Delete
'NOTE: FindNext does not work when a row from the
range
'has been deleted. Must repeat full find method
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole,
SearchOrder:=xlByColumns _
, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
Loop While Not Y Is Nothing
End If
Next Serial
Sheets("Sheet1").Select
Columns("A:A").Delete
Range("A1").Select
Sheets("Sheet2").Select
Columns("A:A").Delete
Range("A1").Select
End Sub
--------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------