Loop column A and delete and move on condition

[Rob]

Hi,
I'm trying to loop through cells in column A (say rows 1 to 500) and if the
length of contents is 0, clear contents as there will be apostrophes in the
cells. If on the other hand the length of contents is greater than 0, I
want to place the contents from column A in column C of the same row, whilst
removing the contents of column A.

I've tried various pieces of code but run into Debug mode!

Thanks, Rob

 

[Ron de Bruin]

If you have two '' in a cell Len will count 1.
What do you do then?

 

[Rob]

Ron,

Because the apostrophes are set by a previous routine, there will only be
two tests: firstly whether the cell appears empty but has an apostrophe or
whether there is some text.

I'm really interested in moving the text from column A to CO but can't just
copy and paste as there is other contents in column CO.

Thanks, Rob

 

[Ron de Bruin]

Hi Rob

Try this one for the activesheet
But If you have a cell with two '' in it it will also copy the cell to the C column

Sub Example()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = 500
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "A").Value) Then
'Do nothing, This avoid a error if there is a error in the cell
ElseIf Len(.Cells(Lrow, "A").Value) = 0 Then
.Cells(Lrow, "A").ClearContents
Else
.Cells(Lrow, "C").Value = .Cells(Lrow, "A").Value
End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[Rob]

Ron,

Thanks for this, I'd been trying with OffSet and failing miserably.

Regards, Rob

 

[Tom Ogilvy]

To clear A when the value is moved, add the below line:

Sub Example()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = 500
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "A").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell
ElseIf Len(.Cells(Lrow, "A").Value) = 0 Then
.Cells(Lrow, "A").ClearContents
Else
.Cells(Lrow, "C").Value = .Cells(Lrow, "A").Value
.Cells(Lrow, "A").ClearContents ' <=== added line
End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[Ron de Bruin]

In this example you can use the Offset like this

.Cells(Lrow, "A").Offset(0, 2).Value = .Cells(Lrow, "A").Value