Run time error 13 when closing worksheet

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I am using a code that hasnt given me any problems until this morning when i made an edit

When i debug i see this line of code in yellow, please can you advise what its actually doing / telling me.

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("P6:U6"))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each c In rng
        If Not c.HasFormula Then c.Value = UCase(c.Value)
    Next c
    Application.EnableEvents = True
End If
End Sub


Below is the code i have in use & the edits that ive made were to add Option Button 3 & 4

Rich (BB code): 
Private Sub CloseForm_Click()
Unload DiscoForm
End Sub
Private Sub TextBox1_Change()
    TextBox1 = UCase(TextBox1)
    TextBox2.Visible = True
End Sub
Private Sub TextBox2_Change()
    TextBox2 = UCase(TextBox2)
    TextBox3.Visible = True
End Sub
Private Sub TextBox3_Change()
    TextBox3 = UCase(TextBox3)
    TextBox4.Visible = True
End Sub
Private Sub TextBox4_Change()
    TextBox4 = UCase(TextBox4)
    TextBox5.Visible = True
End Sub
Private Sub TextBox5_Change()
    TextBox5 = UCase(TextBox5)
    TextBox6.Visible = True
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox6 = UCase(TextBox6)
    TextBox7.Visible = True
    OptionButton1.Visible = False
    OptionButton2.Visible = True
    OptionButton3.Visible = True
    OptionButton4.Visible = True
    If Me.TextBox6.Value = "" Then Exit Sub
       Me.OptionButton1.Value = True

End Sub
Private Sub TextBox7_Change()
    TextBox7 = UCase(TextBox7)
   For i = 1 To 1000
DoEvents
Sleep (7) ' THIS DELAY ALLOWS THE USER TO SELECT M, X or N IF OTHER REMOTE IS USED
Next i
Call DISCOCODE
End Sub
Private Sub OptionButton1_Click()
     Me.TextBox7.Value = "G" ' LAND ROVER
End Sub
Private Sub OptionButton2_Click()
     Me.TextBox7.Value = "M" 
End Sub
Private Sub OptionButton3_Click()
     Me.TextBox7.Value = "X" 
End Sub
Private Sub OptionButton4_Click()
     Me.TextBox7.Value = "N" 
End Sub
Sub DISCOCODE()

    ThisWorkbook.Worksheets("Sheet1").Range("P6") = Me.TextBox1.Text
    ThisWorkbook.Worksheets("Sheet1").Range("Q6") = Me.TextBox2.Text
    ThisWorkbook.Worksheets("Sheet1").Range("R6") = Me.TextBox3.Text
    ThisWorkbook.Worksheets("Sheet1").Range("S6") = Me.TextBox4.Text
    ThisWorkbook.Worksheets("Sheet1").Range("T6") = Me.TextBox5.Text
    ThisWorkbook.Worksheets("Sheet1").Range("U6") = Me.TextBox6.Text
    ThisWorkbook.Worksheets("Sheet1").Range("P7") = Me.TextBox7.Text
    ActiveWorkbook.Save
    Application.ScreenUpdating = True

    Unload Me
    
Dim answer As Long
Dim currentShape As Shape

Sheets("Sheet1").Range("P6:U6").Copy Sheets("Sheet1").Range("E6")
Sheets("Sheet1").Range("P7").Copy Sheets("Sheet1").Range("E7")

Sheets("Sheet1").Range("E6:J6").Copy Sheets("PRINT LABELS").Range("E5")
Sheets("PRINT LABELS").Range("E6").Value = Sheets("Sheet1").Range("E7").Value


Sheets("Sheet1").Activate
ActiveSheet.Range("M6").Select

    Application.ScreenUpdating = False
    
   
    With Sheets("PRINT LABELS")
        For Each currentShape In .Shapes
            If currentShape.Type = msoPicture Then
                currentShape.Delete
            End If
        Next currentShape
    End With
    
    Application.ScreenUpdating = True
    
ActiveWorkbook.Save

With Sheets("PRINT LABELS")
.Activate
.Range("A1").Select
Range("AB1").Value = Range("E5").Value & Range("F5").Value & Range("G5").Value & Range("H5").Value & Range("I5").Value & Range("J5").Value
.Range("AB1").Copy

End With
End Sub

Private Sub Userform_initialize()
TextBox2.Visible = False
TextBox3.Visible = False
TextBox4.Visible = False
TextBox5.Visible = False
TextBox6.Visible = False
TextBox7.Visible = False
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = False

    Me.StartUpPosition = 0
    Me.Top = Application.Top + 340  ' MARGIN FROM TOP OF SCREEN
    Me.Left = Application.Left + Application.Width - Me.Width - 150 ' LEFT / RIGHT OF SCREEN

End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
ipbr21054 said:
I am using a code that hasnt given me any problems until this morning when i made an edit
Click to expand...
The only problem I found is if the cell has an error, in which case:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range
  Set rng = Intersect(Target, Range("P6:U6"))
  If Not rng Is Nothing Then
      Application.EnableEvents = False
      For Each c In rng
        If Not c.HasFormula Then
          If Not IsError(c) Then
            c.Value = UCase(c.Value)
          End If
        End If
      Next c
      Application.EnableEvents = True
  End If
End Sub

But if you are going to convert the text to uppercase and the editing is done from the userform, then don't do it in the event, do it from the userform, for example:
VBA Code: 
  ThisWorkbook.Worksheets("Sheet1").Range("P6") = UCase(Me.TextBox1.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("Q6") = UCase(Me.TextBox2.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("R6") = UCase(Me.TextBox3.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("S6") = UCase(Me.TextBox4.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("T6") = UCase(Me.TextBox5.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("U6") = UCase(Me.TextBox6.Text)
  ThisWorkbook.Worksheets("Sheet1").Range("P7") = Me.TextBox7.Text
Or:
VBA Code: 
    With ThisWorkbook.Worksheets("Sheet1")
      .Range("P6") = UCase(Me.TextBox1.Text)
      .Range("Q6") = UCase(Me.TextBox2.Text)
      .Range("R6") = UCase(Me.TextBox3.Text)
      .Range("S6") = UCase(Me.TextBox4.Text)
      .Range("T6") = UCase(Me.TextBox5.Text)
      .Range("U6") = UCase(Me.TextBox6.Text)
      .Range("P7") = Me.TextBox7.Text
    End With
 
Upvote 0
Hi,
Im getting a little lost here.

Do i need to replce

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("P6:U6"))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each c In rng
        If Not c.HasFormula Then c.Value = UCase(c.Value)
    Next c
    Application.EnableEvents = True
End If
End Sub

WITH

Rich (BB code): 
       Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("P6:U6"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each c In rng
If Not c.HasFormula Then
If Not IsError(c) Then
c.Value = UCase(c.Value)
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub


Also im looking at this,but not sure where i add it.

Rich (BB code): 
    With ThisWorkbook.Worksheets("Sheet1")
      .Range("P6") = UCase(Me.TextBox1.Text)
      .Range("Q6") = UCase(Me.TextBox2.Text)
      .Range("R6") = UCase(Me.TextBox3.Text)
      .Range("S6") = UCase(Me.TextBox4.Text)
      .Range("T6") = UCase(Me.TextBox5.Text)
      .Range("U6") = UCase(Me.TextBox6.Text)
      .Range("P7") = Me.TextBox7.Text
    End With
 
Upvote 0
1. Remove this code from your sheet.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("P6:U6"))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each c In rng
        If Not c.HasFormula Then c.Value = UCase(c.Value)
    Next c
    Application.EnableEvents = True
End If
End Sub

2. Update your userform code to this:
VBA Code: 
Sub DISCOCODE()
  With ThisWorkbook.Worksheets("Sheet1")
    .Range("P6") = UCase(Me.TextBox1.Text)
    .Range("Q6") = UCase(Me.TextBox2.Text)
    .Range("R6") = UCase(Me.TextBox3.Text)
    .Range("S6") = UCase(Me.TextBox4.Text)
    .Range("T6") = UCase(Me.TextBox5.Text)
    .Range("U6") = UCase(Me.TextBox6.Text)
    .Range("P7") = Me.TextBox7.Text
  End With
  Application.ScreenUpdating = True
  
  Unload Me
  
  Dim answer As Long
  Dim currentShape As Shape
  
  Sheets("Sheet1").Range("P6:U6").Copy Sheets("Sheet1").Range("E6")
  Sheets("Sheet1").Range("P7").Copy Sheets("Sheet1").Range("E7")
  
  Sheets("Sheet1").Range("E6:J6").Copy Sheets("PRINT LABELS").Range("E5")
  Sheets("PRINT LABELS").Range("E6").Value = Sheets("Sheet1").Range("E7").Value
  
  
  Sheets("Sheet1").Activate
  ActiveSheet.Range("M6").Select
  
  Application.ScreenUpdating = False
  
  
  With Sheets("PRINT LABELS")
  For Each currentShape In .Shapes
  If currentShape.Type = msoPicture Then
  currentShape.Delete
  End If
  Next currentShape
  End With
  
  Application.ScreenUpdating = True
  
  ActiveWorkbook.Save
  
  With Sheets("PRINT LABELS")
  .Activate
  .Range("A1").Select
  Range("AB1").Value = Range("E5").Value & Range("F5").Value & Range("G5").Value & Range("H5").Value & Range("I5").Value & Range("J5").Value
  .Range("AB1").Copy
  
  End With
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

I
  • Solved
Date on userform shows tomorros date NOT todays
Replies
1
Views
196
ipbr21054
I
I
  • Question Question
Checkbox doesnt show checkmark when it should
Replies
2
Views
180
ipbr21054
I
K
  • Question Question
Help Needed
2
Replies
13
Views
334
kwavic
K
J
  • Solved
Hide Buttons Selectively
Replies
3
Views
114
dmt32
D
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
212
ipbr21054
I

Forum statistics

Threads
1,224,825
Messages
6,181,190
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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
Back
Top