Please Help: Macro Nearly Finished

[Guest]

Hi Guys,

I have a macro that needs about 2 or 3 sections completing. I'm very nearly
finished. The Macro I have at the moment looks like this:

' Delete Column A & C
' Delete Rows 1 to 7

Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Rows("1:7").Select
Selection.Delete Shift:=xlUp

' Replace . with / in D.O.B

Columns("B:B").Select
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("B:B").Select

' Insert 4 new Columns (B,C,D,E)

Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

' Sort Column A "Text To Columns"

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

' Insert New Column in Row B

Columns("B:B").Select

Selection.Insert Shift:=xlToRight

' Enter "=IF(E1<>"",E1,IF(D1<>"",D1,C1))" Into Cell B1.

' Copy This Formula Down To Last Cell With Data In Row

HELP NEEDED HERE

' Insert New Column

Columns("B:B").Select
Selection.Insert Shift:=xlToRight

' Copy Data From Column C and Paste Values in Column B.

HELP NEEDED HERE

' Delete Rows C to G.

HELP NEEDED HERE


I have enterred 'HELP NEEDED HERE' at the points I need help. If anyone
knows what I need here, please let me know!!

Thanks!
Dave

 

[Guest]

Easy. See code below. I made some addtional changes in other places in the
code.

Hi Guys,

I have a macro that needs about 2 or 3 sections completing. I'm very nearly
finished. The Macro I have at the moment looks like this:

' Delete Column A & C
' Delete Rows 1 to 7 columns("A:A").delete
columns("C:C").delete
rows("1:7").delete


Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Rows("1:7").Select
Selection.Delete Shift:=xlUp

' Replace . with / in D.O.B

Columns("B:B").Select
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("B:B").Select

' Insert 4 new Columns (B,C,D,E) Columns("C").insert
Columns("C").insert
Columns("C").insert
Columns("C").insert


Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

' Sort Column A "Text To Columns"

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

' Insert New Column in Row B

Columns("B:B").Select

Selection.Insert Shift:=xlToRight

' Enter "=IF(E1<>"",E1,IF(D1<>"",D1,C1))" Into Cell B1.

' Copy This Formula Down To Last Cell With Data In Row

HELP NEEDED HERE

Lastrow = cells(rows.count,"A").end(xlup).row

' Insert New Column

Columns("B:B").Select
Selection.Insert Shift:=xlToRight

' Copy Data From Column C and Paste Values in Column B.

HELP NEEDED HERE

columns("C:C").copy destination:=Columns("B:B")