Hi Tom,

Thanks for replying. The asterisk is there. For some reason the sytem we
use has it. However after I run the macro I am going to do a "Text To
Columns" and change the location from this * J101 J101 to J101, so I will be
getting rid of the asterik and have the location once instead of twice. I
hope that helps.

Mascot

"Tom Ogilvy" wrote:

Assume the asterisk is not actually there and that was for emphasis only.

Assume you are actually displaying column B and C and the location is less
than 9 characters long. Further assume that accounts will be at least 9
characters long

'Add Data
Dim lastrow As Long
Dim i As Long, loc As String

Columns(1).ClearContents
lastrow = Cells(Rows.Count, 2).End(xlUp).Row

For i = lastrow To 1 Step -1
If len(trim(Cells(i, 2))) 8 Then
Cells(i, 1) = loc
Else
loc = Cells(i, 2)
End If
Next

Dim rng As Range
On Error Resume Next
Set rng = Columns(1).SpecialCells(xlBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

--
Regards,
Tom Ogilvy


"Mascot" wrote:

Hi,

I have a spreadsheet were I have list of accounts and they are catergorized
by location in the same column. For example Column B looks like this.

P100161000 Cash
P100262000 AR
P100363000 AP
P100464000 Fixed Assets
P100565000 Inventory
* J101 J101
P100161000 Cash
P100262000 AR
P100363000 AP
P100565000 Inventory
* M102 M102

So it will list the accounts and then the last item will be the location.
What I want to do is have the location in column A right next to the account.
Does anyone have a macro that can go down the list and put the location in
front
of the account? And then delete the row with the location.

By the way I have a macro that will do it if one is alphanumeric and the
other is not, but as you can see both cells are alphanumeric in this one. I
will copy the code I have below.

'Add Data
Dim lastrow As Long
Dim i As Long, loc As String

Columns(1).ClearContents
lastrow = Cells(Rows.Count, 2).End(xlUp).Row

For i = lastrow To 1 Step -1
If IsNumeric(Cells(i, 2)) Then
Cells(i, 1) = loc
Else
loc = Cells(i, 2)
End If
Next

Dim rng As Range
On Error Resume Next
Set rng = Columns(1).SpecialCells(xlBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If

Thanks
Mascot