macro to find numeric data & move it
 

I need a macro that will look down column B and when it finds a
number, move that number to the corresponding cell in column A, then
copy this down until it finds a blank in column B.

I've tried to layout an example below:

A B C D

1 TEXT

2 TEXT

3 123

4 TEXT AGAIN

5 TEXT AGAIN

6

7 987

8 MORE TEXT

9 MORE TEXT


after the macro runs I want the following result:

A B C D

1 TEXT

2 TEXT

3 123

4 123 TEXT AGAIN

5 123 TEXT AGAIN

6

7 987

8 987 MORE TEXT

9 987 MORE TEXT


Sub MoveIt()
msg = "Don't forget to put a '* Total' at the foot of the column"
If MsgBox(msg, vbOKCancel, "Reminder..") = 2 Then Exit Sub
Do While ActiveCell < "'* Total"
With ActiveCell
' PLACE YOUR CODE IN HERE
End With
Loop
End Sub

My problem is, I have no idea what code to place in the ' PLACE YOUR
CODE IN HERE area!

Any help much appreciated.

macro to find numeric data & move it
 

Give this a try...

Sub MoveIt()
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim varTargetNumber As Variant

varTargetNumber = ""
Set rngToSearch = Range("B1", Range("B65536").End(xlUp).Offset(-1, 0))


If MsgBox("Don't forget to put a '* Total' at the foot of the column", _
vbOKCancel, "Reminder..") = vbCancel Then Exit Sub
For Each rngCurrent In rngToSearch
If IsNumeric(rngCurrent) Then
varTargetNumber = rngCurrent.Value
rngCurrent.Value = ""
End If
rngCurrent.Offset(0, -1).Value = varTargetNumber
Next rngCurrent
End Sub
--
HTH...

Jim Thomlinson


"Steve Simons" wrote:

I need a macro that will look down column B and when it finds a
number, move that number to the corresponding cell in column A, then
copy this down until it finds a blank in column B.

I've tried to layout an example below:

A B C D

1 TEXT

2 TEXT

3 123

4 TEXT AGAIN

5 TEXT AGAIN

6

7 987

8 MORE TEXT

9 MORE TEXT


after the macro runs I want the following result:

A B C D

1 TEXT

2 TEXT

3 123

4 123 TEXT AGAIN

5 123 TEXT AGAIN

6

7 987

8 987 MORE TEXT

9 987 MORE TEXT


Sub MoveIt()
msg = "Don't forget to put a '* Total' at the foot of the column"
If MsgBox(msg, vbOKCancel, "Reminder..") = 2 Then Exit Sub
Do While ActiveCell < "'* Total"
With ActiveCell
' PLACE YOUR CODE IN HERE
End With
Loop
End Sub

My problem is, I have no idea what code to place in the ' PLACE YOUR
CODE IN HERE area!

Any help much appreciated.

macro to find numeric data & move it
 

Jim

This is spot-on, worked first time.

Many thanks, you saved me and my colleagues hours of work, it's very
much appreciated.

Steve


On Fri, 15 Jul 2005 10:28:04 -0700, "Jim Thomlinson"
wrote:

Give this a try...

Sub MoveIt()
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim varTargetNumber As Variant

varTargetNumber = ""
Set rngToSearch = Range("B1", Range("B65536").End(xlUp).Offset(-1, 0))


If MsgBox("Don't forget to put a '* Total' at the foot of the column", _
vbOKCancel, "Reminder..") = vbCancel Then Exit Sub
For Each rngCurrent In rngToSearch
If IsNumeric(rngCurrent) Then
varTargetNumber = rngCurrent.Value
rngCurrent.Value = ""
End If
rngCurrent.Offset(0, -1).Value = varTargetNumber
Next rngCurrent
End Sub