Eliminating cells

  • Thread starter Thread starter GWC
  • Start date Start date
G

GWC

Col A has 3,444 cells
Col B contains 94,422 cells

How can I eliminate the cells in COL B if their 7 left-most characters are NOT equal to the 7 left-most characters in the cells in COL A?
 
Here's a portion of my spreadsheet:

col a
0000074 0016126
0000078 0506094
0000360 0013053
0000417 0001440
0001640 0507920
0001770 0001148
0001771 0001148
0001981 0001115
0001991 0016196
0002035 0016210
0003013 0515025
0003014 0514881
0030280 0016100
0030287 0016210
0030289 0016235
0089146 0016023
0089540 0016053
0090507 0009027
0092740 0500959
0092846 0016028
0092929 0518246
0133103 0002439
0133202 0507376
0133204 0524935
0350195 0016200
0350389 0016250
0350898 0001857
0350901 0011990
0396699 0016176
0396700 0523975
0396702 0016210
0396703 0002248
0403059 0002009
0403062 0016210
0403101 0001011
0403918 0001842

=============================
col b
0000074-2010 05
0000078-2010 05
0000360-2011 05
0000417-2011 05
0001770-2012 CO
0001771-2012 CO
0001981-2012 00
0001981-2012 CO
0001981-2012 CO
0001991-2012 00
0001991-2012 CO
0001991-2012 CO
0030054-2011 CO
0030088-2012 CO
0030094-2012 05
0030119-2011 CO
0030120-2011 CO
0030280-2011 00
0030280-2011 CO
0030280-2011 CO
0030287-2011 CO
0030289-2011 CO
0030308-2012 CO
0031400-2011 CO
0031409-2011 00
0031409-2011 CO
0031409-2011 CO
0031409-2012 05
0031409-2012 05
0031409-2012 05
0031409-2012 05
0031409-2012 05
0031415-2011 00
0031415-2011 CO
0133085-2010 05
0133085-2010 05
0133085-2010 05
0133118-2010 05
0133186-2010 05
0133187-2010 05
0133188-2010 05
0133189-2010 05
0133190-2010 05
0133191-2010 05
0133192-2010 05
0133193-2010 05
0133194-2010 05
0133195-2010 05
0133202-2010 05
0133203-2010 05
0133204-2010 05
0133205-2010 05
0133206-2010 05
0133207-2010 05
0133208-2010 05
0350193-2010 CO
0350194-2010 00
0350194-2010 00
0350194-2010 CO
0350194-2010 CO
0350195-2010 00
0350195-2010 CO
0350195-2010 CO
0350196-2010 00
0350197-2010 00
0350197-2010 00
0350198-2010 00
0350229-2011 05
0350238-2011 00
0350239-2011 00
0350332-2011 05
0350389-2011 00
0350389-2011 CO
0350897-2010 CO
0350898-2010 00
0350899-2010 00
0350899-2010 05
0350901-2010 CO
0396662-2011 00
0396663-2011 05
0396664-2011 00
0396696-2011 CO
0396698-2011 CO
0396699-2011 00
0396699-2011 CO
0396699-2011 CO
0396700-2011 CO
0396701-2011 00
0396701-2011 CO
0396701-2011 CO
0396702-2011 00
0396702-2011 CO
0396702-2011 CO
0396703-2011 CO
0396704-2011 CO
0396705-2011 CO
0401944-2011 CO
0402929-2011 00
0402929-2011 CO
0402929-2011 CO
0403918-2011 CO
 
Col A has 3,444 cells

Col B contains 94,422 cells



How can I eliminate the cells in COL B if their 7 left-most characters are NOT equal to the 7 left-most characters in the cells in COL A?

Try this on a sample of your data.
Select B1 and run the code.
Change "For x = 1 To 100" to cover your data rows.


Option Explicit
Sub DeleIt()

Dim cell As Range
Dim x As Integer

For x = 1 To 100
If Left(ActiveCell, 7) <> Left(ActiveCell.Offset(0, -1), 7) Then
ActiveCell.Value = ""
End If
ActiveCell.Offset(1, 0).Select
Next
End Sub

Regards,
Howard
 
Howard said:
Try this on a sample of your data.
Select B1 and run the code.
Change "For x = 1 To 100" to cover your data rows.


Option Explicit
Sub DeleIt()

Dim cell As Range
Dim x As Integer

For x = 1 To 100
If Left(ActiveCell, 7) <> Left(ActiveCell.Offset(0, -1), 7) Then
ActiveCell.Value = ""
End If
ActiveCell.Offset(1, 0).Select
Next
End Sub

This code will run faster if you don't select each cell to work on. Also, I
think GWC probably wants each cell in B compared against *every* cell in A.
So...

Sub DeleIt()
For L0 = 1 To Cells(1, 2).End(xlDown).Row
chk = Left(Cells(L0, 2).Value, 7)
For L1 = 1 To Cells(1, 1).End(xlDown).Row
If (chk) = Left(Cells(L1, 1).Value, 7) Then GoTo okay
Next
Cells(L0, 2).Clear
okay:
Next
End Sub

This clears the contents of the cells, as opposed to deleting the cell and
moving what's underneath it up. If you *want* the cells to be moved up,
then use this instead:

Sub DeleIt2()
For L0 = 1 To Cells(1, 2).End(xlDown).Row
chk = Left(Cells(L0, 2).Value, 7)
If Len(chk) Then
For L1 = 1 To Cells(1, 1).End(xlDown).Row
If (chk) = Left(Cells(L1, 1).Value, 7) Then GoTo okay
Next
Cells(L0, 2).Delete xlShiftUp
L0 = L0 - 1
End If
okay:
Next
End Sub

In both subs, "Cells(1, 1).End(xlDown).Row" can be replaced with 3444 if
that limit isn't going to change (or if this is a one-off sort of thing).
Ditto for "Cells(1, 2).End(xlDown).Row" -> 94422.
 
Back
Top