Consulting

Results 1 to 10 of 10

Thread: Solved: case to line 1 locks up

  1. #1

    Solved: case to line 1 locks up

    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

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Keep your options within the Select Case structure. It's easier to follow
    Without the looping, try
    [VBA]
    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
    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    BTW, the problem is here, I think. Counter never reaches 0, so Check is never false
    [VBA]
    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

    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  4. #4
    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!

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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.[vba]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
    [/vba]
    There are a number of statements that I don't know what are doing there. I've left 'em in.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    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!

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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?
    Last edited by p45cal; 07-21-2009 at 02:15 PM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    Nobody there?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  10. #10
    Quote Originally Posted by p45cal
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •