Private sub causes too much screen jumping

[Brettjg]

I have code in a worksheet to expand the next column when an entry is made,
or to contract the column when an entry is deleted. It all works properly,
but every time the entry in (say) "H34" changes and the macro expands COLUMN
"J" it also checks through all of the others (there'll be 40 in all, so it's
quite tiresome to watch). Furthermore every time I enter data into any cell
on the sheet it goes through its checking routine. How can I get it to do
just the one next column when "H34" changes, and not do its check when I
enter data in other cells?

By the way, my preference was actually to hide/unhide the next column, but
that was way too jumpy. I then changed it to just shrink the column right
down but it's still not good to watch and use.

A sample of the code is as follows (there are 40 of these "With" statements)

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Range("H34") > "0" Then
Columns("I").ColumnWidth = 25
ElseIf Range("H34") < "1" Then
Columns("I").ColumnWidth = 0.5
End If
End With

With Target
If Range("I34") > "0" Then
Columns("J").ColumnWidth = 25
ElseIf Range("I34") < "1" Then
Columns("J").ColumnWidth = 0.5
End If
End With

Thankyou for your time and brain.
Regards, Brett.

 

[Mike]

Application.ScreenUpdating=False 'Paste this at beginning of code
Application.ScreenUpdating=True 'Paste this at the bottom of code

 

[Brettjg]

Hey Mike, that's wonderfully simple and effective. Thankyou. Hmmm, not I've
got to tell you a bit more. There's actually another bit at the start of the
sub:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
With Target
If Not Range("loan.sought") = Range("G1") Then
Application.Run "recall_GP_equity_yield"
Range("loan.sought").Copy
Range("G1").PasteSpecial Paste:=xlPasteValues
Range("loan.sought").Select
Application.CutCopyMode = False
End If
End With

With Target
If Range("H34") > "0" Then
Columns("I").ColumnWidth = 25
ElseIf Range("H34") < "1" Then
Columns("I").ColumnWidth = 0.5
End If
End With

With Target
If Range("I34") > "0" Then
Columns("J").ColumnWidth = 25
ElseIf Range("I34") < "1" Then
Columns("J").ColumnWidth = 0.5
End If
End With

Now without that first IF about the loan.sought cell your suggestion is
working really well, but as soon as I reintroduced it the flicking started
again. The bit about

Application.Run "recall_GP_equity_yield"

is just to bring in an information panel, but when its there and visible it
jumps like crikey when change any of the "H34" etc cells. Any more clues?
Regards, Brett.

 

[Mike]

In this module is there Application.Run "recall_GP_equity_yield"
Application.ScreenUpdating = False

 

[Brettjg]

I've actually changed it to the following:

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
If Not Range("loan.sought") = Range("G1") Then 'this is to check whether
"loan.sought" has changed
ActiveSheet.Shapes("Gp equity yield").Select
Selection.ShapeRange.IncrementLeft -5000
Selection.ShapeRange.IncrementTop -5000
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 60
Range("loan.sought").Copy
Range("G1").PasteSpecial Paste:=xlPasteValues
Range("loan.sought").Select
Application.CutCopyMode = False
End If

Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

With Target
If Range("H34") > "0" Then
Columns("I").ColumnWidth = 25
ElseIf Range("H34") < "1" Then
Columns("I").ColumnWidth = 0.5
End If
End With

It's tolerable now, but it still flickers with every cell entry (regardless
of whether those cells should trigger the macro.

 

[Mike]

You only what to turn ScreenUpdating off once and then on once

 

[Brettjg]

I tried all sorts of combos, but it seems to work best with that last code I
showed you (turning the screenupdate off/on in both the private subs). At
least I can go back to hide/unhide now rather than just shrinking the
columns. Looks like I have to live with a little flicker (unless you have
another idea). Thanks a lot Mike, you help has been great. Brett

 

[Mike]

Application.Calculation = xlManual 'Beggining
Application.Calculation = xlAutomatic 'End

 

[Mike]

Application.ScreenUpdating = False 'Begginning
Application.Calculation = xlManual

Application.Calculation = xlAutomatic 'End
Application.ScreenUpdating = True