Workbook freezes

Hi experts

I'm still struggling with my workbook that will often crashing when other workbooks are open at the same time. I've asked a similar question before, as I thought it was due to the use of a select function (see this post Alternative to select function in VBA? ). And therefore I ask for your help again.

The workbook will usually freeze if 2 or more workbooks are open at the same time and if I try to enter data into my VBA containing workbook. Nearly all the VBA code in my workbook are organized in the different worksheet modules or in ThisWorkbook, and not in the general modules, as this was the way it was organised when I took over the maintenance of the workbook.  

The screenshot of the worksheet that causes the freeze when entering data:
 Dataark-screendump.jpg
The code from the worksheet above:
Option Explicit

Dim wb As Workbook
Dim DataArk As Worksheet 'definerer at "DataArk" er et regneark
Dim rInput As Range
Dim rOutput As Range
Dim rText As Range
Dim rInputValg1 As Range
Dim rOutputValg1 As Range
Dim rTextValg1 As Range
Dim rInputValg2 As Range
Dim rOutputValg2 As Range
Dim rTextValg2 As Range
Dim rUdviklValg As Range
Dim Beregn As Worksheet


Private Sub Worksheet_Change(ByVal Target As Range)

Set wb = ThisWorkbook
Set DataArk = wb.Sheets("Indtastning")
Set rInput = DataArk.Range("C27:D100,I27:J100,L27:M100,O27:P100,R27:S100")
Set rOutput = DataArk.Range("C16:C17,C19,E27:E100,K27:K100,N27:N100,Q27:Q100,T27:T100")
Set rText = DataArk.Range("B27:B100,H27:H100")
Set rInputValg1 = DataArk.Range("C10")
Set rOutputValg1 = DataArk.Range("C11")
Set rTextValg1 = DataArk.Range("C13")
Set rInputValg2 = DataArk.Range("F10")
Set rOutputValg2 = DataArk.Range("F11")
Set rTextValg2 = DataArk.Range("F13")
Set rUdviklValg = DataArk.Range("G19")
Set Beregn = wb.Worksheets("Beregninger")

'Låser arket op
ThisWorkbook.Worksheets("Indtastning").Unprotect Password:=9876

'Styrer input format

If Not Intersect(Target, rInputValg1) Is Nothing Then
    If rInputValg1 = "" Then
        rInputValg1 = "Procent (0 decimaler)"
    Else
        rInput.Select
    
        Select Case rInputValg2
    
        Case 0
            Selection.NumberFormat = "0"
        
        Case 1
            Selection.NumberFormat = "0.0"
        
        Case 2
            Selection.NumberFormat = "0.00"
        
        Case 5
            Selection.NumberFormat = "0%"
        
        Case 6
            Selection.NumberFormat = "0.0%"
            
        Case 7
            Selection.NumberFormat = "0.00%"
            
        End Select
 
    rInputValg1.Activate
    
   Beregn.Calculate
    End If
End If

'Styrer output format
If Not Intersect(Target, rOutputValg1) Is Nothing Then
    
    If rOutputValg1 = "" Then 'Hvis cellens indhold forsøges slettet
        rOutputValg1 = "Procent (0 decimaler)" 'Så indsættes dette

    
    Else
    
        rOutput.Select
    
        Select Case rOutputValg2
    
        Case 0
            Selection.NumberFormat = "0"
        
        Case 1
            Selection.NumberFormat = "0.0"
        
        Case 2
            Selection.NumberFormat = "0.00"
        
        Case 5
            Selection.NumberFormat = "0%"
            
        Case 6
            Selection.NumberFormat = "0.0%"
            
        Case 7
            Selection.NumberFormat = "0.00%"
    
        End Select

    rOutputValg1.Activate
    Beregn.Calculate
    End If
End If
   
'Styrer om input er tekst eller dato
If Not Intersect(Target, rTextValg1) Is Nothing Then
    If rTextValg1 = "" Then
    rTextValg1 = "Tekst"
    
    Else
        rText.Select
    
        Select Case rTextValg2
    
        Case 0
            Selection.NumberFormat = "General"
        
        Case 1
            With Selection
                .NumberFormat = "mmm/yyyy"
                .HorizontalAlignment = xlLeft
            End With
    
        End Select
       
    rTextValg1.Activate
    Beregn.Calculate
    End If
End If

If rUdviklValg = "" Then
    rUdviklValg = "Vælg"
    Beregn.Calculate
End If

'Låser arket
ThisWorkbook.Worksheets("Indtastning").Protect Password:=9876

End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Set wb = ThisWorkbook
Set DataArk = wb.Sheets("Indtastning")
Dim oCtrl As Office.CommandBarControl

If DataArk.Cells(1, 7) = 0 Then

'Disable all Cut menus

     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)

           oCtrl.Enabled = False

    Next oCtrl

Application.CellDragAndDrop = False
Application.OnKey "^x", ""

End If

End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)


Dim oCtrl As Office.CommandBarControl

'Enable all Cut menus

     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)

            oCtrl.Enabled = True

     Next oCtrl

Application.CellDragAndDrop = True
Application.OnKey "^x"


End Sub

Open in new window


I imagine that something in the code above is faulty or not declared precisely enough, as the freeze only seems to happen then using that single worksheet.

However I'll insert the code from ThisWorkbook and from one of the worksheets containing the graphs, as there might be some I have overlooked.

Code from ThisWorkbook:
Option Explicit
Dim wb As Workbook

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Set wb = ThisWorkbook

With wb.Worksheets("Udskrift - Seriediagram 1 serie").PageSetup
    .PrintArea = "$A$1:$O$37"
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With

With wb.Worksheets("Udskrift - Seriediagram 4 serie").PageSetup
    .PrintArea = "$A$1:$O$37"
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
   
With wb.Worksheets("Udskrift - Søjlediagram").PageSetup
    .PrintArea = "$A$1:$O$37"
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Skjuler diverse ark
Ark2.Visible = xlSheetHidden
Ark4.Visible = xlSheetHidden
Ark5.Visible = xlSheetHidden

Dim txtFileName As String
 
    '1. Check of Save As was used
    If SaveAsUI = True And Application.UserName <> "My username" Then
        Cancel = True
 
    '2. Call up your own dialog box.  Cancel out if user Cancels in the dialog box
        txtFileName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "Save As XLSM file")
        If txtFileName = "False" Then
            'MsgBox "You didn't save", vbOKOnly
            Cancel = True
            Exit Sub
        End If
    '3. Save the file.
       Application.EnableEvents = False
        ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=52
        Application.EnableEvents = True
       
    End If
End Sub

Private Sub Workbook_Open()
'Sørger for at det altid er ark1 som der ses når regnearket åbnes
ThisWorkbook.Worksheets("Indtastning").Activate

End Sub

Open in new window


And the code from the one of the other worksheets (code is similar to the other worksheets with graphs):
Dim wb As Workbook
Dim serie1 As Worksheet

Private Sub Worksheet_Activate()
Set wb = ThisWorkbook
Set serie1 = wb.Worksheets("Udskrift - Seriediagram 1 serie")

Calculate

' Låser arket op
Ark7.Unprotect Password:=9876

    wb.ActiveSheet.ChartObjects("Diagram 1").Activate
    wb.ActiveChart.Axes(xlValue).Select

' Styrer om maximum på x-aksen er manuelt eller automatisk sat
    If serie1.Cells(6, 13) = "" Then
        ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
    Else
        ActiveChart.Axes(xlValue).MaximumScaleIsAuto = False
        ActiveChart.Axes(xlValue).MaximumScale = Cells(6, 13)
    End If
    
' Styrer om minimum på x-aksen er manuelt eller automatisk sat
    If serie1.Cells(7, 13) = "" Then
        ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
    Else
        ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
        ActiveChart.Axes(xlValue).MinimumScale = serie1.Cells(7, 13)
    End If
    
' Styrer enhed på den overordnede gitterlinie på x-aksen
    If serie1.Cells(6, 13) = "" Or serie1.Cells(7, 13) = "" Then
        ActiveChart.Axes(xlValue).MajorUnitIsAuto = True
    Else
        ActiveChart.Axes(xlValue).MajorUnitIsAuto = False
        ActiveChart.Axes(xlValue).MajorUnit = serie1.Cells(8, 13)
    End If
     
With ActiveChart.SeriesCollection(3)
 .HasDataLabels = True
    With .DataLabels
    If serie1.Cells(9, 13) = 0 Then
     .NumberFormat = "0"

     ElseIf serie1.Cells(9, 13) = 1 Then
     .NumberFormat = "0.0"

     ElseIf serie1.Cells(9, 13) = 2 Then
     .NumberFormat = "0.00"

     ElseIf serie1.Cells(9, 13) = 5 Then
     .NumberFormat = "0%"

     ElseIf serie1.Cells(9, 13) = 6 Then
     .NumberFormat = "0.0%"

     ElseIf serie1.Cells(9, 13) = 7 Then
    .NumberFormat = "0.00%"
    End If


    .Position = xlLabelPositionAbove
        With .Font
        .Name = "Mari"
        .FontStyle = "Bold"
        .Size = 14
        .Bold = msoTrue
        End With
        With .Format
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.Transparency = 0.5
        .Fill.Solid
        End With
    End With
End With
     
     
' Styrer om output er tal eller procent
    Select Case serie1.Cells(9, 13)
    
        Case 0
            Selection.TickLabels.NumberFormat = "0"
        
        Case 1
            Selection.TickLabels.NumberFormat = "0.0"
        
        Case 2
            Selection.TickLabels.NumberFormat = "0.00"
        
        Case 5
            Selection.TickLabels.NumberFormat = "0%"
        
        Case 6
            Selection.TickLabels.NumberFormat = "0.0%"
    
        Case 7
            Selection.TickLabels.NumberFormat = "0.00%"
    
    End Select

' Styrer om der er en grøn eller rød ramme om grafen
If serie1.Cells(11, 13) = "1" Then
    ActiveChart.ChartArea.Format.Line.Visible = msoTrue
    ActiveChart.ChartArea.Format.Line.ForeColor.RGB = RGB(51, 204, 51)
    ActiveChart.ChartArea.Format.Line.DashStyle = msoLineSolid
    ActiveChart.ChartArea.Format.Line.Weight = 10
 ElseIf serie1.Cells(11, 13) = "2" Then
    ActiveChart.ChartArea.Format.Line.Visible = msoTrue
    ActiveChart.ChartArea.Format.Line.ForeColor.RGB = RGB(204, 0, 0)
    ActiveChart.ChartArea.Format.Line.DashStyle = msoLineSolid
    ActiveChart.ChartArea.Format.Line.Weight = 10
Else
    ActiveChart.ChartArea.Format.Line.Visible = msoFalse
End If
    
' Angiver printområdet og justerer til kun 1 side
With ActiveSheet.PageSetup
    .PrintArea = "$A$1:$O$37"
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With

'Låser arket
Ark7.Protect Password:=9876
    
serie1.Range("A1").Select

End Sub

Open in new window


So much important:
Any help with figuring out what the freezing problem might be will be much appreciated.

No so important, but will still be appreciated:
Any suggestions to cleaning up the code and to which code that can be moved til the general modules will also be much appreciated as I don't know where to begin.

Thanks for your help
NackeyQualitative ConsultantAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieVBA ExpertCommented:
You definitely don't need to use Selection in the first set of  posted code, though what to replace it with isn't clear because you don't actually select anything.:)

Could you clarify what you are actually referring to when using Selection, is it perhaps Target?

Could you upload a sample workbook?
0
NackeyQualitative ConsultantAuthor Commented:
The Selection are referring to a range of cells that should change depending on the select.case. So yes the selection are supposed to be a Target.

A sample of my workbook has been attached.
0
NorieVBA ExpertCommented:
I don't see any attached workbook, just some images and the code.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

NackeyQualitative ConsultantAuthor Commented:
Now with workbook
Sample-workbook.xlsm
0
Ejgil HedegaardCommented:
I tried it with 4 other workbooks open, with a total of more than 50 MB, and it works without any problems typing in many blank cells.
Only auto-recovery stops everything, resulting in a white screen while saving.
So it must be something else than the workbook itself that makes the workbook freeze.
Try opening the Task-manager, select Processes and minimize it.
When the workbook freeze, select the Task-Manager in the process line, and look at Processes to see what else than Excel is using the CPU.

The code acts on worksheet change event, activate event etc., so it is best placed where it is.
There are no need to move it to modules.
In Worksheet_Change for "Indtastning" you could add Application.ScreenUpdating = False in the beginning. It speeds up a bit, and avoids screen flickering.
No need for that on the chart sheets, since nothing happens until the chart update.
Remove Calculate in all modules. Not needed since the workbook is Auto-calculated.
No need to select rInput, rOutput etc.
Delete the line and use the range directly in the Case Select statements like this for Case 0, rInput.NumberFormat = "0"
Page setup is quite slow, and it does not change, so move all the page setup for all sheets to Workbook_Open, to do it once, and not every time the sheet is selected.
The Workbook_BeforePrint event I also not needed then, and can be deleted.
Or remove the page setups completely.
They are not needed once set, and the sheets are protected, so the page setup does not change.

I would recommend using datavalidation on the input texts.
False input for "Talformat" cause the program to fail.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
NackeyQualitative ConsultantAuthor Commented:
Didn't really solve my freezing workbook, but it seems to be a problem only existing at my workplace computer.

Great to get feedback on the code. That was much appreciated.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.