Help with Creating a Macros!

[Mascot]

Hi Everyone,

I have pasted two sheets below. Also if you have a gmail account you can go
to the following link to see an example.

http://spreadsheets.google.com/ccc?key=pvgJO9XxypCwEyZxSbqckBQ

Anyways I am trying to creat a macro that will take me from the first sheet
to the second sheet.

clmn A clmn B clmn C clmn D clmn E
(Row2) Lead column Prior Pd Pd Activ. Current Pd
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* MN01 MN01 1,000.00 1,400.00 1,800.00
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* MR01 MR01 1,000.00 1,400.00 1,800.00
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* J701 J701 1,000.00 1,400.00 1,800.00
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* J801 J801 1,000.00 1,400.00 1,800.00
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* K201..K201RM K201 1,000.00 1,400.00 1,800.00
P100161000 Cash 100.00 200.00 300.00
P100262000 AR 200.00 300.00 400.00
P100363000 AP 300.00 400.00 500.00
P100464000 Fixed Assets 400.00 500.00 600.00
* K301..K301RM K301 1,000.00 1,400.00 1,800.00
** Total 6,000.00 8,400.00 10,800.00


Second
clmn A clmn B clmn C clmn D clmn E
clmn F
LOC Lead column Description Prior Pd Pd Activ. Current Pd
MN01 100161000 Cash 100.00 200.00 300.00
MN01 100262000 AR 200.00 300.00 400.00
MN01 100363000 AP 300.00 400.00 500.00
MN01 100464000 Fixed Assets 400.00 500.00 600.00
MN01 Total 1,000.00 1,400.00 1,800.00
MR01 100161000 Cash 100.00 200.00 300.00
MR01 100262000 AR 200.00 300.00 400.00
MR01 100363000 AP 300.00 400.00 500.00
MR01 100464000 Fixed Assets 400.00 500.00 600.00
MR01 Total 1,000.00 1,400.00 1,800.00
J701 100161000 Cash 100.00 200.00 300.00
J701 100262000 AR 200.00 300.00 400.00
J701 100363000 AP 300.00 400.00 500.00
J701 100464000 Fixed Assets 400.00 500.00 600.00
J701 Total 1,000.00 1,400.00 1,800.00
J801 100161000 Cash 100.00 200.00 300.00
J801 100262000 AR 200.00 300.00 400.00
J801 100363000 AP 300.00 400.00 500.00
J801 100464000 Fixed Assets 400.00 500.00 600.00
J801 Total 1,000.00 1,400.00 1,800.00
K201 100161000 Cash 100.00 200.00 300.00
K201 100262000 AR 200.00 300.00 400.00
K201 100363000 AP 300.00 400.00 500.00
K201 100464000 Fixed Assets 400.00 500.00 600.00
K201 Total 1,000.00 1,400.00 1,800.00
K301 100161000 Cash 100.00 200.00 300.00
K301 100262000 AR 200.00 300.00 400.00
K301 100363000 AP 300.00 400.00 500.00
K301 100464000 Fixed Assets 400.00 500.00 600.00
K301 Total 1,000.00 1,400.00 1,800.00
Grand Total 6000 8400 10800


Thanks
Mascot

 

[PY & Associates]

Read the sample, saved, but not aware where to locate it to work on.

Anyway, it is a relatively simple matter.
Please send file to us direct.

 

[PY & Associates]

Try this please

Option Explicit
Private Sub main()
Dim wsb As Worksheet
Dim wsa As Worksheet
Dim srcrng As Range
Dim c As Range
Dim srow As Integer
Dim erow As Integer
Dim i As Integer
Dim loc As String

Set wsb = Sheets("Before")
'Sheets.Add
'ActiveSheet.Name = "After2"
Set wsa = Sheets("After2")
wsa.Cells.ClearContents
wsb.Range("B2").CurrentRegion.Copy wsa.Range("B1")

wsa.Select
Range("A1") = "LOC"
Columns("C").Insert
Range("C1") = "Description"

srow = 2
erow = Cells(Rows.Count, 2).End(xlUp).Row - 1
For i = 6 To erow Step 5
loc = Right(Cells(i, "B"), 4)
Range(Cells(srow, "A"), Cells(i - 1, "A")) = loc
Cells(i, "A") = loc & " Total"
Cells(i, "B").ClearContents
srow = i + 1
Next i

Cells(erow + 1, "A") = "Grand Total"
Cells(erow + 1, "B").ClearContents

Set srcrng = Range(Range("B2"), Range("B2").End(xlDown))
srcrng.TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(10, 1)),
TrailingMinusNumbers:=True
srcrng.Replace what:="P", replacement:=" "
Columns("A:F").AutoFit

End Sub