asked on

Slight change to Macro to expand Cell

EE Pros,

I have a Macro that EE helped me build. What it does is expand the Wrap Text capability so you can type in line after line of text and then it will auto. expand the cell. Very cool!

Here's my question; when I copy a cell, outside the column that is affected by this macro, it auto copies the Wrap Text attribute. Is there a way to limit it to a specific Column?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target.Cells
Application.ScreenUpdating = False
c.WrapText = True

If c.WrapText Then c.Rows.AutoFit
Next
Application.ScreenUpdating = True
End Sub

Saurabh Singh Teotia

Let's Say you want to do this for A Column only..then you can do this code..This will wrap text only when you write in A Column...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
Dim c As Range
For Each c In Target.Cells
        Application.ScreenUpdating = False
c.WrapText = True

        If c.WrapText Then c.Rows.AutoFit
        Next
        Application.ScreenUpdating = True
End Sub

Open in new window

Saurabh...

Bright01

ASKER

Thank you! I think I get it. One last question..... when I add "insert copied cells" as I expand my model, it takes a minute or two. I believe that's because, although I've limited the macro to a single column, it is going through the entire spreadsheet as it adds the copied cells. If I want to speed up the process, can I simply limit the range? In your example above, it would be something like modifying the range to A6:A500 instead of A:A....... is that right?

Thanks again,

B.

Professor J

bright01

yes, limit your range and here is the modified code limited to the specific range.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A6:A500")) Is Nothing Then Exit Sub
Dim c As Range
For Each c In Target.Cells
        Application.ScreenUpdating = False
c.WrapText = True

        If c.WrapText Then c.Rows.AutoFit
        Next
        Application.ScreenUpdating = True
End Sub

Open in new window

Saurabh Singh Teotia

Like Jim said..you need to change this line..

If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub

To this..

If Intersect(Target, Me.Range("A6:A500")) Is Nothing Then Exit Sub

Bright01

ASKER

Jim and Saurabh,

I tried this. It didn't work. Let me describe the problem to you;

First, if I turn off this macro, I can cut and paste rows easily.

If I then Copy a row and insert Copied Cells, it hangs for 1 to 2 minutes. Then the Row is inserted.

help!

B.

Bright01

ASKER

"If I then turn the Macro back on, and Copy a row and insert Copied Cells, it hangs for 1 to 2 minutes. Then the Row is inserted."

Sorry.

B.

Saurabh Singh Teotia

Ahhh i see your problem.. Use this version of code...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A6:A500")) Is Nothing Then Exit Sub
Dim c As Range, r As Range
Set Rng = Range("A" & Target.Row & ":A" & Target.Row)
For Each c In Rng
        Application.ScreenUpdating = False
c.WrapText = True

        If c.WrapText Then c.Rows.AutoFit
        Next
        Application.ScreenUpdating = True
End Sub

Open in new window

Saurabh...

Bright01

ASKER

Saurabh,

I think we almost have it. I'm still getting an error "rng is "variable not defined"..........

B.

ASKER CERTIFIED SOLUTION

Saurabh Singh Teotia

membership

This solution is only available to members.

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

Start Free Trial

Bright01

ASKER

Saurabh and Jim,

Thank you for trouble shooting this. In the end, Saurabh's guidance was "on the money" for fixing the issue.

Thanks again,

B.

Professor J

thanks Bright01 for the feedback.

glad Saurabh's solution worked for you.