Out of Memory

[Gvlewis81]

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 . . . .

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