Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Deleting rows with 11+ characters.
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 ---------------------------------------------------------------------------*----------------------- ---------------------------------------------------------------------------*----------------------- |
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Deleting rows with 11+ characters.
Not sure why you need to split the keys into 8 or 9 charaters. Possibly they
need to be declared as double or may want to treat them as character instead of number. code below will sort a block data where the data may be on more than one row. Sub Sortblock() Const BlockRows = 3 Const StartRow = 2 SortColumn = 1 LastRow = Cells(Rows.Count, 1).End(xlUp).Row LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column For i = StartRow To (LastRow - BlockRows) Step BlockRows For j = (StartRow + BlockRows) To LastRow Step BlockRows If Cells(i, SortColumn) Cells(j, SortColumn) Then Set CutRange = Range(Cells(j, 1), _ Cells(j + BlockRows - 1, 1)).EntireRow CutRange.Cut Range("A" & i).Insert Shift:=xlDown End If Next j Next i End Sub "Sinner" wrote: 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 ---------------------------------------------------------------------------Â*----------------------- ---------------------------------------------------------------------------Â*----------------------- |
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Deleting rows with 11+ characters.
One way:
No need to trim that I can see. Dim vArr As Variant Dim rCell As Range Dim rDelete As Range Dim nLow As Long Dim nHigh As Long Dim i As Long Dim sTest As String With Sheets("Sheet1") vArr = .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)).Value End With nLow = LBound(vArr, 1) nHigh = UBound(vArr, 1) With Sheets("Sheet2") For Each rCell In .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)) sTest = rCell.Text For i = nLow To nHigh If sTest = vArr(i, 1) Then If rDelete Is Nothing Then Set rDelete = rCell Else Set rDelete = Union(rDelete, rCell) End If End If Next i Next rCell If Not rDelete Is Nothing Then rDelete.EntireRow.Delete End With In article .com, "Sinner" wrote: 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. |
#4
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Deleting rows with 11+ characters.
On Mar 31, 6:51 pm, JE McGimpsey wrote:
One way: No need to trim that I can see. Dim vArr As Variant Dim rCell As Range Dim rDelete As Range Dim nLow As Long Dim nHigh As Long Dim i As Long Dim sTest As String With Sheets("Sheet1") vArr = .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)).Value End With nLow = LBound(vArr, 1) nHigh = UBound(vArr, 1) With Sheets("Sheet2") For Each rCell In .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)) sTest = rCell.Text For i = nLow To nHigh If sTest = vArr(i, 1) Then If rDelete Is Nothing Then Set rDelete = rCell Else Set rDelete = Union(rDelete, rCell) End If End If Next i Next rCell If Not rDelete Is Nothing Then rDelete.EntireRow.Delete End With In article .com, "Sinner" wrote: 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.- Hide quoted text - - Show quoted text - Dear Joel & JE McGimpsey, Thank you for your replies. JE McGimpsey I want to reuse the same sheet with another set of data. I have added Sub Clear() Sheets(Array("Sheet1", "Sheet2")).Select Sheets("Sheet1").Activate Cells.Select Selection.Clear Sheets("Sheet2").Select Range("A1").Select Sheets("Sheet1").Select Range("A1").Select End Sub Clear is assigned to a clear button & your script to another button. I get a run time error after I clear the sheet with above & reuse your script. Any idea?? |
#5
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Deleting rows with 11+ characters.
On Mar 31, 6:51 pm, JE McGimpsey wrote:
One way: No need to trim that I can see. Dim vArr As Variant Dim rCell As Range Dim rDelete As Range Dim nLow As Long Dim nHigh As Long Dim i As Long Dim sTest As String With Sheets("Sheet1") vArr = .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)).Value End With nLow = LBound(vArr, 1) nHigh = UBound(vArr, 1) With Sheets("Sheet2") For Each rCell In .Range(.Cells(1, 1), _ .Cells(.Rows.Count, 1).End(xlUp)) sTest = rCell.Text For i = nLow To nHigh If sTest = vArr(i, 1) Then If rDelete Is Nothing Then Set rDelete = rCell Else Set rDelete = Union(rDelete, rCell) End If End If Next i Next rCell If Not rDelete Is Nothing Then rDelete.EntireRow.Delete End With In article .com, "Sinner" wrote: 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.- Hide quoted text - - Show quoted text - Dear I have placed your script after a button. I need to have an error message if any of the two sheets is empty like "List unavailable. Input list.". Thx JE McGimpsey, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Deleting rows with 11+ characters. | Excel Discussion (Misc queries) | |||
Deleting rows based on number of characters | Excel Discussion (Misc queries) | |||
Deleting characters that are not numbers | Excel Discussion (Misc queries) | |||
Deleting Blank Characters in a Cell | Excel Discussion (Misc queries) | |||
Deleting 3 Text characters from the right | Excel Worksheet Functions |