Move a cell based on value

[racerx03]

I have a list of data in a column the includes numbers and text, I want to move the numbers greater than 22000 to the left column (A)

Example Data in Column B
<table style="width: 65pt; border-collapse: collapse;" x:str="" border="0" cellpadding="0" cellspacing="0" width="87"><colgroup><col style="width: 65pt;" width="87"></colgroup><tbody><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); width: 65pt; height: 12.75pt; background-color: transparent;" x:num="" align="right" height="17" width="87">240010</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">FS</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">
</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" x:num="" align="right" height="17">220014</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">2005 FTRS</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">
</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" x:num="" align="right" height="17">240014</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">2005 FTRS</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">
</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" x:num="" align="right" height="17">220015</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">F/S- R S</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">
</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">006 210</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">F/S- M S, JR.</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">
</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" x:num="" align="right" height="17">220013</td></tr><tr style="height: 12.75pt;" height="17"><td style="border: medium none rgb(212, 208, 200); height: 12.75pt; background-color: transparent;" height="17">F/S- D S</td></tr></tbody></table>

OK, I have some simple code I reused from MS examples, this will change each of the cells (greater then 220000) yellow, but, how do I loop through the selection (about 400 rows) and move the resulting highlighted cells 1 column left?

Sub Check_Values_1()
   Dim CurCell As Object
   For Each CurCell In Selection
      If Val(CurCell.Text) > 220000 Then CurCell.Interior.ColorIndex = 6
      Next
End Sub

 

[Smitty]

Welcome to the Board!

How about:

If Val(CurCell.Text) > 220000 Then CurCell.Cut CurCell.Offset.(,1)

Hope that helps,

 

[sous2817]

Couldn't you use an "If" formula

=IF(B1>22000,B1,"")

Just put it in the cell where you want B1 to show up and drag it down to the end.

 

[schielrn]

If you want to move them and clear the contents of the original spot try this:

Sub Check_Values_1()
   Dim CurCell As Range
   For Each CurCell In Selection
      If CurCell.value > 220000 Then
         CurCell.offset(0,-1).value = curcell.value
         curcell.clearcontents
      End If
   Next
End Sub

Hope that helps.

 

[racerx03]

schielrn, sous2817, Smitty - thanks! that did it with a minor change

Sub Check_Values_1()
Dim CurCell As Range
For Each CurCell In Selection
If Val(CurCell.Text) > 220000 Then
CurCell.Offset(0, -1).Value = CurCell.Value
CurCell.ClearContents
End If
Next
End Sub

When I used,
CurCell.value > 220000

It moves some of the text (unless it is proceeded by a number like, 2005 FTR) as well as the intended numbers? I'm not sure why?
thanks for the help