Excel VBA - app freeze when running macro

[yozzer_01]

Hi
I am new here and fairly new to excel vba. When I run the code below to populate a given row input select, excel freezes . It works OK with when input say 3.

Sub Record_Num()
Dim MyNum As Integer
Dim Record As Integer
Dim IP As Integer
Dim Logo As Integer
Dim EAN As Integer
Dim Phase As Integer
Dim FilClass As Integer
Dim StoreTemp As Integer
Worksheets("Sheet1").Activate
Application.ScreenUpdating = True
MyNum = Application.InputBox("Enter Number of Records")
For Record = 1 To MyNum
For Logo = 1 To MyNum
For IP = 1 To MyNum
For EAN = 1 To MyNum
For Phase = 1 To MyNum
For FilClass = 1 To MyNum
For StoreTemp = 1 To MyNum
Cells(30, StoreTemp + 2).Value = "-40 - + 70" & Chr(186) & "C"
With Cells(28, FilClass + 2).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Unfiltered,Line Class Filter A,Line Class Filter B"
.ShowInput = True
.ShowError = True
End With
With Cells(14, Phase + 2).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="3Ø AC,1Ø AC"
.ShowInput = True
.ShowError = True
End With
With Cells(11, EAN + 2).Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, Operator:=xlEqual, Formula1:="12"
.ErrorMessage = "Must be first 12 digits of 13 digit EAN Number"
.ShowInput = True
.ShowError = True
End With
Cells(1, Record + 2).Value = "Record" & " " & Record
With Cells(2, Logo + 2).Font
.Name = "Siemens Logo"
.Size = 11
End With
With Cells(27, IP + 2).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=" , , IP20,IP54,IP55,IP65"
.ShowInput = True
.ShowError = True
End With
Next StoreTemp
Next FilClass
Next Phase
Next EAN
Next IP
Next Logo
Next Record
End Sub


T

 

[Jonmo1]

It's not locking...
It's just taking an extremely long time to execute....

You have 7 loops using the same Value (1 to MyNum)

So if MyNum is say 3, then you're doing the loop 3*3*3*3*3*3*3 times (2187)
When all is said and done, only 7 cells are modified per loop (21)

So you're looping 2187 times to manipulate 18 cels.
Essentially, the work is done after 3 loops, the same thing is getting REdone 2184 times.

Imagine how much bigger that gets when MyNum is much larger....


You only need 1 loop.

Try

Sub Record_Num()
Dim Record As Integer, MyNum As Integer
Worksheets("Sheet1").Activate
Application.ScreenUpdating = True
MyNum = Application.InputBox("Enter Number of Records")
For Record = 1 To MyNum
    Cells(30, Record + 2).Value = "-40 - + 70" & Chr(186) & "C"
    With Cells(28, Record + 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Unfiltered,Line Class Filter A,Line Class Filter B"
        .ShowInput = True
        .ShowError = True
    End With
    With Cells(14, Record + 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="3Ø AC,1Ø AC"
        .ShowInput = True
        .ShowError = True
    End With
        With Cells(11, Record + 2).Validation
        .Delete
        .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, Operator:=xlEqual, Formula1:="12"
        .ErrorMessage = "Must be first 12 digits of 13 digit EAN Number"
        .ShowInput = True
        .ShowError = True
    End With
    Cells(1, Record + 2).Value = "Record" & " " & Record
    With Cells(2, Record + 2).Font
        .Name = "Siemens Logo"
        .Size = 11
    End With
    With Cells(27, Record + 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=" , , IP20,IP54,IP55,IP65"
        .ShowInput = True
        .ShowError = True
    End With
Next Record
End Sub

 

[yozzer_01]

Many thanks for your help,
Code works great & a lesson learnt on looping.

Yozzer_01