Out of Memory

Gvlewis81

Board Regular
Joined
Feb 5, 2013
Messages
200
Hi i'm writing code for a button thats pushed in a pretty complex userform.

I seem to have hit a brick wall as whenever i try to write more code i'm getting an "Out of Memory" message come up and connot enter more code.

I'm very basic and self taught writer so have no idea when it comes to this. Below is the code i've written so far.

Nt sure where to go to be honest . . . .


Code:
Private Sub CommandButton1_Click()
If Addressline1.Value = "" Then
    MsgBox "Please enter an address"
    Exit Sub
End If


'copy template and move to new sheet


Sheets("Template").Select
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = UserForm1.Addressline1.Value
    
'Populate first floor Info


If floor0.Value = True Then
     With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Value = "First Floor"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 14
        .Font.Underline = True
        End With


    
    
    'entrance hall----------------------------------------------------------------------------------
    If EntranceHallbx.Value = True Then
    
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Value = "Entarnce Hall"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 12
        End With
        
        'merge entrance hall title to fit weeks--------------------------
        
            Set usethis = Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp)
            'if 4 weeks
                If week4.Value = True Then
                Worksheets(Addressline1.Value).Range("A" & usethis.Row & ":" & "E" & usethis.Row).Select
                With Selection
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                End With
            'if 3 weeks
            End If
            If week3.Value = True Then
            Worksheets(Addressline1.Value).Range("A" & usethis.Row & ":" & "D" & usethis.Row).Select
            With Selection
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            End With
            'if 2 weeks
                End If
                   If week2.Value = True Then
                    Worksheets(Addressline1.Value).Range("A" & usethis.Row & ":" & "C" & usethis.Row).Select
                    With Selection
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    End With
        'if 1 week
        End If
        If week4.Value = False And week3.Value = False And week2.Value = False Then
        Worksheets(Addressline1.Value).Range("A" & usethis.Row & ":" & "B" & usethis.Row).Select
        With Selection
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        End With
        End If
    'finish merging------------
    
    
    'set headings---------------------
        'description
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Value = "Description"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 10
        .Font.Italic = True
        End With
        
        'week 1
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, 1)
        .Value = "Week 1"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 10
        .Font.Italic = True
        End With
        'week 2
        If week2.Value = True Or week3.Value = True Or week4.Value = True Then
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, 2)
        .Value = "Week 2"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 10
        .Font.Italic = True
        End With
        End If
        'week 3
        If week3.Value = True Or week4.Value = True Then
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, 3)
        .Value = "Week 3"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 10
        .Font.Italic = True
        End With
        End If
        'week 4
        If week4.Value = True Then
        With Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, 4)
        .Value = "Week 4"
        .Font.Bold = True
        .Font.Name = "Garamond"
        .Font.Size = 10
        .Font.Italic = True
        End With
        End If
        'finish headings--------------------------------
        
        
        
        
        
        
        'fill entrance hall info
        
        On Error Resume Next
        
        For i = 1 To 18
        If Me.Controls("EH" & i).Value = True Then
        Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Me.Controls("EH" & i).Caption
            For x = 1 To 4
                If Me.Controls("EH" & i & "W" & x).Value = True Then
                
        
        Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, x).Value = "Y"
        End If
        Next x
        End If
        Next i
        
        'Ehall Other
        For i = 1 To 5
        If Me.Controls("EHO" & i).Value > "" Then
        Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Me.Controls("EHO" & i).Value
            For x = 1 To 4
                If Me.Controls("EHO" & i & "W" & x).Value = True Then
                
        
        Worksheets(Addressline1.Value).Range("A" & Rows.Count).End(xlUp).Offset(0, x).Value = "Y"
        End If
        Next x
        End If
        Next i
        
        
        
    End If ' if entrancehallbox = true
        
    
    
    
    
    
    
End If 'if floor0.value = true






With Worksheets(Addressline1.Value)
Columns("A:D").EntireColumn.AutoFit
End With
End Sub
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Watch MrExcel Video

Forum statistics

Threads
1,123,493
Messages
5,601,998
Members
414,490
Latest member
Rip181

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
Top