PDA

View Full Version : Solved: case to line 1 locks up



pingwin77
07-21-2009, 08:02 AM
I have a user form setup to add rows to my report based on a number input into "textboxDIMS." I start with 2 row so that I can copy and paste the bottom one that does not have the darker border on top (merely for cosmetics) Once and a while I will only need one row of data so I have a case setup to delete the bottom row. When I try to run this scenario, excel locks up. Any ideas why? Line 1 in the case below (Highlighted in RED)is what is supposed to do the trick.

Thanks in advance for looking at this!


Private Sub CommandButton1_Click()
'Adds variables from user form to sheet 1
With ActiveWorkbook.Sheets("sheet1")

Sheets("sheet1").Range("C2:F3").ClearContents
Sheets("sheet1").Range("C2").Value = TextBoxPARTS.Value
Sheets("sheet1").Range("D2").Value = TextBoxDIMS.Value
Sheets("sheet1").Range("E2").Value = TextBoxTRIALS.Value
Sheets("sheet1").Range("F2").Value = TextBoxTOL.Value
If OptionButton1 = True Then
Sheets("sheet1").Range("G2").Value = "6.00"
Else
Sheets("sheet1").Range("G2").Value = "5.15"
End If
End With


' Add_Rows_Devaiation Macro
' Macro recorded 9/9/2002 by Gary
' Macro edited 10/24/2007 by Mike
' Macro edited 01/06/2009 by Mike
Application.ScreenUpdating = False
Dim Check, Counter, Features As Range, Message, Title, Default, FeaturesValue
Dim MLRValue

TextBoxPARTS = Val(TextBoxPARTS.Text)
TextBoxDIMS = Val(TextBoxDIMS.Text)
TextBoxTRIALS = Val(TextBoxTRIALS.Text)
FeaturesValue = TextBoxDIMS

Select Case FeaturesValue
Case 0: GoTo line3
Case 1: GoTo line1
Case 2: GoTo Line4
Case Is > 2: GoTo line2
End Select

line1:
Rows(8).Delete
Range("J7").Select
Unload Me

line2:
FeaturesValue = FeaturesValue - 2
Check = True: Counter = FeaturesValue ' Add number of features
ActiveSheet.Rows(8).Select
Selection.Copy
Do ' Outer loop.
Do While Counter > 0 ' Inner loop.
Counter = Counter - 1 ' Increment Counter.

ActiveCell.Offset(1, 0).Activate
ActiveSheet.Paste

If Counter = 0 Then ' If condition is True.
Check = False ' Set value of flag to False.
Exit Do ' Exit inner loop.
End If
Loop
Loop Until Check = False ' Exit outer loop immediately.

Application.CutCopyMode = False
Range("J7").Select

GoTo Line4

line3:
MsgBox "You can not have 0 features in this report. Please try again.", vbOKOnly
Unload Me

Line4:
Unload Me
End Sub

mdmackillop
07-21-2009, 09:43 AM
Keep your options within the Select Case structure. It's easier to follow
Without the looping, try

Option Explicit
Private Sub CommandButton1_Click()
Dim tgt As Range
'Adds variables from user form to sheet 1
With ActiveWorkbook.Sheets("sheet1")
Sheets("sheet1").Range("C2:F3").ClearContents
Sheets("sheet1").Range("C2").Value = TextBoxPARTS.Value
Sheets("sheet1").Range("D2").Value = TextBoxDIMS.Value
Sheets("sheet1").Range("E2").Value = TextBoxTRIALS.Value
Sheets("sheet1").Range("F2").Value = TextBoxTOL.Value
If OptionButton1 = True Then
Sheets("sheet1").Range("G2").Value = "6.00"
Else
Sheets("sheet1").Range("G2").Value = "5.15"
End If
End With

' Add_Rows_Devaiation Macro
' Macro recorded 9/9/2002 by Gary
' Macro edited 10/24/2007 by Mike
' Macro edited 01/06/2009 by Mike
Application.ScreenUpdating = False
Dim Check, Counter, Features As Range, Message, Title, Default, FeaturesValue
Dim MLRValue
TextBoxPARTS = Val(TextBoxPARTS.Text)
TextBoxDIMS = Val(TextBoxDIMS.Text)
TextBoxTRIALS = Val(TextBoxTRIALS.Text)
FeaturesValue = TextBoxDIMS
Select Case FeaturesValue
Case 0
MsgBox "You can not have 0 features in this report. Please try again.", vbOKOnly
Unload Me
Case 1
Rows(8).Delete
Range("J7").Select
Unload Me
Case 2
Unload Me
Case Else
FeaturesValue = FeaturesValue - 2
Check = True: Counter = FeaturesValue ' Add number of features
Set tgt = Cells(9, 1).Resize(Counter)
ActiveSheet.Rows(8).Copy tgt
Range("J7").Select
End Select
End Sub

mdmackillop
07-21-2009, 09:45 AM
BTW, the problem is here, I think. Counter never reaches 0, so Check is never false

Do While Counter > 0 ' Inner loop.
Counter = Counter - 1 ' Increment Counter.

ActiveCell.Offset(1, 0).Activate
ActiveSheet.Paste

If Counter = 0 Then ' If condition is True.
Check = False ' Set value of flag to False.
Exit Do ' Exit inner loop.
End If
Loop

pingwin77
07-21-2009, 09:56 AM
I did not know you could do it that way. Thanks!

As for the code in "Case Else", am I missing how that works? When I ran the code it did not do anything for a value greater than 2. I changes the coding for "Case Else" to get it to copy and past as I need it to by adding my original code for that section. Is your way easier/better and if so, how does that work?

***AHH!!! i was never skipping the next "case" value after "case 1." It should have gone to the end and unloaded.

Thanks for the help!

p45cal
07-21-2009, 09:59 AM
When you've chosen to add 1 row, you enter the Select Case statement with FeaturesValue = 1, so 'Goto Line1' is executed, and execution goes to the label 'Line1'. So far so good. The 3 statements below that get executed, and then the next line to get executed is
FeaturesValue = FeaturesValue - 2
directly beneath the label 'Line2'. We know that FeaturesValue has the value 1 at this stage, but the line makes it -1. The variable Counter is also set to -1. It then selects row 8 (the blank row you've only just deleted).
We now enter your outer loop - the one that is controlled by
Loop Until Check = False
Straightaway we enter the inner loop, the one controlled by
Do While Counter > 0
but Counter is -1, so this inner loop is not entered. Importantly, this inner loop contains the code to set Check = False. So when the line
Loop Until Check = False
is encounterd, Check will never be False! So you're in a never ending loop = Excel appearing to hang.

I don't know why you've got two loops here, I think you should only need 1.
More importantly, it's these GoTo instructions that make the code like spaghetti to follow.
I've changed the sub to take out the Goto intructions and to have only one loop. See if it helps.Private Sub CommandButton1_Click()
'Adds variables from user form to sheet 1
With ActiveWorkbook.Sheets("sheet1")

Sheets("sheet1").Range("C2:F3").ClearContents
Sheets("sheet1").Range("C2").Value = TextBoxPARTS.Value
Sheets("sheet1").Range("D2").Value = TextBoxDIMS.Value
Sheets("sheet1").Range("E2").Value = TextBoxTRIALS.Value
Sheets("sheet1").Range("F2").Value = TextBoxTOL.Value
If OptionButton1 = True Then
Sheets("sheet1").Range("G2").Value = "6.00"
Else
Sheets("sheet1").Range("G2").Value = "5.15"
End If
End With


' Add_Rows_Devaiation Macro
' Macro recorded 9/9/2002 by Gary
' Macro edited 10/24/2007 by Mike
' Macro edited 01/06/2009 by Mike
Application.ScreenUpdating = False
Dim Check, Counter, Features As Range, Message, Title, Default, FeaturesValue
Dim MLRValue

TextBoxPARTS = Val(TextBoxPARTS.Text)
TextBoxDIMS = Val(TextBoxDIMS.Text)
TextBoxTRIALS = Val(TextBoxTRIALS.Text)
FeaturesValue = TextBoxDIMS

Select Case FeaturesValue
Case 0
MsgBox "You can not have 0 features in this report. Please try again.", vbOKOnly
Case 1
Rows(8).Delete
Range("J7").Select
Case Is > 2
FeaturesValue = FeaturesValue - 2
ActiveSheet.Rows(8).Select
Selection.Copy
Do While FeaturesValue > 0 ' Inner loop.
ActiveCell.Offset(1, 0).Activate
ActiveSheet.Paste
FeaturesValue = FeaturesValue - 1
Loop
Application.CutCopyMode = False
End Select
Unload Me
Range("J7").Select
End Sub

There are a number of statements that I don't know what are doing there. I've left 'em in.

pingwin77
07-21-2009, 11:15 AM
thanks for all the help! I have another question that is similar to this. I now have this range of information that is generated from the code we have been talking about. I now need to copy this new range of data as a group and paste a known offset and number of times.

I attached the workbook I am working with. The button on sheet one gathers the information in the cells at the top of the sheet. (#parts, #dims,#trials....)

Sheet 2 is am example of what needs to happen when you enter 5 Dimension and 5 Parts

Sheet 3 shows the same thing with 3 Dimension and 4 Parts

here is how it should work:

1. The code will generate the block of data first based on the number of dimensions. (this is already done thanks to your help!)

2. The block of data then needs to be copied from cell "A5" through "K?" The ?=the last row in the new block of data plus 2 blank rows. Can be calculated based on the "DIMENSION # + 4"

3. The copied data then gets pasted down the page at an offset so that there is 2 blank rows between each block.

I'm sure this is as clear as mud but I hope it is a start. Please let me know if you have any questions.

Thanks!

p45cal
07-21-2009, 01:49 PM
See attached.
Template on hidden sheet.
Button by itself on another sheet called 'Button'.
A sheet called 'New' is deleted/recreated each time.
Do you want this to be a new workbook rather than a new sheet?

p45cal
07-22-2009, 07:35 AM
Nobody there?

p45cal
07-23-2009, 03:38 AM
I hate it when you spend significant time trying to solve something for someone, for free, and they don't acknowledge it - even though they're busy on the site posting other things over a couple of days.
Makes you want to withdraw helping anyone.

pingwin77
07-23-2009, 09:02 AM
I hate it when you spend significant time trying to solve something for someone, for free, and they don't acknowledge it - even though they're busy on the site posting other things over a couple of days.
Makes you want to withdraw helping anyone.

I want to apologize for this. MY boss is screaming down my back to get this going and I keep getting pulled away from this project to help other and sometimes forget where I was, where I got the help and what my next issue with my coding is. I really do appreciate all the help you and everyone else on this forum do provide. You have been a life saver.