VBA -Excel freezes due to too much information in transfere area

finaljustice

Board Regular
Joined
Oct 6, 2010
Messages
175
Hello,
I've created a userform which contains a COMBOBOX which contains the following CODE:
Code:
Private Sub cboNome2_change()
Application.ScreenUpdating = False
 
For x = 2 To 19
        Sheets(x).Visible = True
    Next
    x = cbZona3.Value
 
    If x = "" Then
 
        MsgBox "Favor selecionar Zona!", , Zona
        Else
 
        Sheets(x).Select
        Range("B5").Select
 
        Do While ActiveCell <> Empty
            If ActiveCell = cboNome2 Then
            clientcell = ActiveCell.Address
            zonaclient = ActiveSheet.Name
                    For i = 1 To 72
                    Controls("Textbox" & i) = Format$(ActiveCell.Offset(0, i + 11), "#,###")
                    Next
            TextBox141 = Format$(ActiveCell.Offset(0, 120), "#,###")
            TextBox142 = Format$(ActiveCell.Offset(0, 121), "#,###")
            TextBox143 = Format$(ActiveCell.Offset(0, 122), "#,###")
            TextBox144 = Format$(ActiveCell.Offset(0, 123), "#,###")
            TextBox145 = Format$(ActiveCell.Offset(0, 124), "#,###")
            TextBox146 = Format$(ActiveCell.Offset(0, 125), "#,###")
 
            TextBox115 = ActiveCell.Offset(0, 138)
            TextBox120 = Format(ActiveCell.Offset(0, 129), "0.00%")
            TextBox121 = Format(ActiveCell.Offset(0, 130), "0.00%")
            TextBox122 = Format(ActiveCell.Offset(0, 131), "0.00%")
 
    Sheets(zonaclient).Select
    Range(clientcell).Select
    ActiveCell.Offset(0, 12).Select
    Range(ActiveCell, Cells(ActiveCell.Row, 256).End(xlToLeft)).Select
    Selection.Copy
    Sheets("Grafico").Select
    Range("B5").Select
    ActiveCell.PasteSpecial (xlPasteValues)
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection(1).XValues = "='Grafico'!$B$4:$BU$4"
    ActiveChart.SeriesCollection(1).Values = "='Grafico'!$B$5:$BU$5"
    ActiveChart.SeriesCollection(1).Name = "=""Volume REAL"""
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).XValues = "='Grafico'!$BV$4:$DE$4"
    ActiveChart.SeriesCollection(2).Values = "='Grafico'!$BV$5:$DE$5"
    ActiveChart.SeriesCollection(2).Name = "='Grafico'!$C$1"
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).MinimumScale = Range("B4").Value
    ActiveChart.Axes(xlCategory).MaximumScale = Range("BU4").Value
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    Selection.Delete
    Set CurrentChart = Sheets("Grafico").ChartObjects(1).Chart
    Fname = ThisWorkbook.Path & "\temp.jpeg"
    CurrentChart.Export Filename:=Fname, FilterName:="jpeg"
    UserForm1.Image2.Picture = LoadPicture(Fname)
    UserForm1.Image1.Picture = LoadPicture(Fname)
    ActiveChart.Parent.Delete
 
    Sheets("Grafico").Select
    Range("B5").Select
    Range("DF5:DN5").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Grafico'!$DF$5:$DN$5")
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions
    ActiveChart.Legend.Select
    Selection.Delete
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(1).Points(1).Interior.ColorIndex = 23
    ActiveChart.SeriesCollection(1).DataLabels(1).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(2).Interior.ColorIndex = 23
    ActiveChart.SeriesCollection(1).DataLabels(2).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(3).Interior.ColorIndex = 23
    ActiveChart.SeriesCollection(1).DataLabels(3).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(4).Interior.ColorIndex = 30
    ActiveChart.SeriesCollection(1).DataLabels(4).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(5).Interior.ColorIndex = 30
    ActiveChart.SeriesCollection(1).DataLabels(5).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(6).Interior.ColorIndex = 30
    ActiveChart.SeriesCollection(1).DataLabels(6).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(7).Interior.ColorIndex = 50
    ActiveChart.SeriesCollection(1).DataLabels(7).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(8).Interior.ColorIndex = 50
    ActiveChart.SeriesCollection(1).DataLabels(8).NumberFormat = "0.0"
    ActiveChart.SeriesCollection(1).Points(9).Interior.ColorIndex = 50
    ActiveChart.SeriesCollection(1).DataLabels(9).NumberFormat = "0.0"
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.SeriesCollection(1).XValues = "='Grafico'!$DF$4:$DN$4"
    ActiveChart.SeriesCollection(1).DataLabels.Select
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    Selection.Delete
    Set CurrentChart = Sheets("Grafico").ChartObjects(1).Chart
    Fname2 = ThisWorkbook.Path & "\temp2.jpeg"
    CurrentChart.Export Filename:=Fname2, FilterName:="jpeg"
    UserForm1.Image3.Picture = LoadPicture(Fname2)
    ActiveChart.Parent.Delete
    Application.CutCopyMode = False
 
    Sheets(zonaclient).Select
    Range(clientcell).Select
 
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
 
Exit Sub
            End If
        ActiveCell.Offset(1, 0).Select
    Loop
  End If
 
For x = 2 To 19
    Sheets(x).Visible = False
Next
End Sub

The code works perfectly if the user uses the MOUSE to click on the dropdown and then select the desired name. Now, given there is the option to speed the process up, if the user tries typing the name of the cliente in the COMBOBOX, excel freezes and I have to shut it down through the taks manager.

Now if I do not make the code generate the graphs (which are a must), the code works both ways, which would be like this:
Code:
Private Sub cboNome2_change()
Application.ScreenUpdating = False
 
For x = 2 To 19
        Sheets(x).Visible = True
    Next
    x = cbZona3.Value
 
    If x = "" Then
 
        MsgBox "Favor selecionar Zona!", , Zona
        Else
 
        Sheets(x).Select
        Range("B5").Select
 
        Do While ActiveCell <> Empty
            If ActiveCell = cboNome2 Then
            clientcell = ActiveCell.Address
            zonaclient = ActiveSheet.Name
                    For i = 1 To 72
                    Controls("Textbox" & i) = Format$(ActiveCell.Offset(0, i + 11), "#,###")
                    Next
            TextBox141 = Format$(ActiveCell.Offset(0, 120), "#,###")
            TextBox142 = Format$(ActiveCell.Offset(0, 121), "#,###")
            TextBox143 = Format$(ActiveCell.Offset(0, 122), "#,###")
            TextBox144 = Format$(ActiveCell.Offset(0, 123), "#,###")
            TextBox145 = Format$(ActiveCell.Offset(0, 124), "#,###")
            TextBox146 = Format$(ActiveCell.Offset(0, 125), "#,###")
 
            TextBox115 = ActiveCell.Offset(0, 138)
            TextBox120 = Format(ActiveCell.Offset(0, 129), "0.00%")
            TextBox121 = Format(ActiveCell.Offset(0, 130), "0.00%")
            TextBox122 = Format(ActiveCell.Offset(0, 131), "0.00%")
 
 
 
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
 
Exit Sub
            End If
        ActiveCell.Offset(1, 0).Select
    Loop
  End If
 
For x = 2 To 19
    Sheets(x).Visible = False
Next
End Sub

Is there a way around this given generating theses graphs are a must?

The excel only freezes if you try typing the name of the client, if you use the mouse to select the clients name it works perfectly, thats why I'm finding it strange.

Thanks in advance for your attention.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,224,590
Messages
6,179,753
Members
452,940
Latest member
rootytrip

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top