asked on

Help with positioning in an Excel Macro

I need to expand the merged cells (currently 2) by one cell to the right in about 100 cells.
When I record the following macro, it works, but every time I run the macro it wants to expand and left justify the same cell.
I tried deleting the line, Range("F1:H1").Select, but then the macro does not work.
How to I get the macro to ignore the original recorded starting point and just begin a the position where the cursor is when I run the macro?

Sub EC()
'
' EC Macro
' Macro recorded 6/30/2015 by user
'
' Keyboard Shortcut: Ctrl+e
'
Range("F1:H1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("F2:G2").Select
End Sub

ASKER CERTIFIED SOLUTION

Professor J

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Kanti Prasad

Hi

To your code above delete Range("F1:H1").Select and add the below on top

Dim Bottom As Long
Dim i As Integer
Bottom = Cells(Rows.Count, "F").End(xlUp).Row
Let Copyrange = "F" & i & ":" & "H" & i
For i = 1 To Bottom
Range(Cells(i, 6), Cells(i, 8)).Select

at the bottom delete Range("F2:G2").Select and add
Next i

Kanti Prasad

Hi

If you want to suppress the msg box then in the 2nd With Selection add
Application.DisplayAlerts = False
End With

With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
'Application.DisplayAlerts = False
.MergeCells = True
Application.DisplayAlerts = False
End With

Bill Golden

ASKER

Marvelous...