Find and move cells with text

  • Thread starter Thread starter KP
  • Start date Start date
K

KP

Hi group,

In column B I want to search for cells containing any text (not numbers) and
then move all of the found cells two columns to the left.
Can someone write a macro that handles this?
Also please include the macro if I want to move to another column and at the
same time to another row.

What can I use if I want to find numeric values in cells?

Regards,
Kaj Pedersen
 
hi,

'cells containing any text
Range("B:B").SpecialCells(xlCellTypeConstants, 2).Copy Range("C1")

'cells containing number
Range("B:B").SpecialCells(xlCellTypeConstants, 1).Copy Range("D1")


--
isabelle



Le 2011-09-20 13:51, KP a écrit :
 
Hi again,

Thank you, your macro finds the cells pretty well, but still there is a
problem.
I don't want the found cells to be inserted from C1 and on.
Here is what I want:
If text is found in e.g. B5, I want the contents of cell B5 to be moved to
A5
Maybe the next text is found in B8. This should be moved to A8
Between B5 and B8 there may be blank cells or cells with numbers that I
don't want to move.

Hope the problem can be solved

Kaj Pedersen
 
Hi Kaj,

I created this:

Sub KajPetersen()
Dim rngLoop As Range
Dim lngRows As Long

' Find last filled cell in column B
lngRows = ActiveSheet.Rows.Count
If IsEmpty(Cells(lngRows, 2)) Then
lngRows = Cells(lngRows, 2).End(xlUp).Row
End If
' Check all cells in column B
For Each rngLoop In Range(Cells(1, 2), Cells(lngRows, 2))
' Only filled cells
If Not (IsEmpty(rngLoop)) Then
' Only non numeric cells
If Not (IsNumeric(rngLoop.Value)) Then
' Copy to column A
rngLoop.Offset(0, -1).Value = rngLoop.Value
End If
End If
Next
End Sub


Hoop this works for you.

Wouter
 
Sub move()
Dim rng As Range
Set rng = Range("B:B").SpecialCells(xlCellTypeConstants, 2)
For Each cell In rng
cell.Cut Destination:=cell.Offset(0, -1)
Next
End Sub


Gord Dibben Microsoft Excel MVP
 
Sub move()
Dim rng As Range
Set rng = Range("B:B").SpecialCells(xlCellTypeConstants, 2)
For Each cell In rng
cell.Cut Destination:=cell.Offset(0, -1)
Next
End Sub
Click to expand...

And without a loop...

Sub move()
Columns("A").Value = Columns("B").Value
Columns("A").SpecialCells(xlCellTypeConstants, xlNumbers).Clear
Columns("A").SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
End Sub
 
And without a loop...
Sub move()
Columns("A").Value = Columns("B").Value
Columns("A").SpecialCells(xlCellTypeConstants, xlNumbers).Clear
Columns("A").SpecialCells(xlCellTypeConstants).Offset(,
1).ClearContents
End Sub
Click to expand...

I accidentally omitted an On Error statement that is necessary in case
SpecialCells finds nothing matching its search criteria...

Sub move()
Columns("A").Value = Columns("B").Value
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeConstants, xlNumbers).Clear
Columns("A").SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
End Sub

Rick Rothstein (MVP - Excel)
 
Back
Top