So, I have a simple macro that just clears out specific cells. It worked fine, and then I added a userform that takes input via textbox and I added the last line TextBox1.Value= "" to clear it. Now, clicking the button that runs the macro works, it even clears the box, but then it gives me the 424 error. I'm sure its something basic I'm overlooking, syntax or some closing argument. Any help would be appreciated.
Sub Clear()
'
' Clear Macro
'
'
Range("A1").Select
Selection.ClearContents
Range("H17").Select
Selection.ClearContents
Range("H11").Select
Selection.ClearContents
Range("B1").Select
Selection.ClearContents
Range("I4").Select
Selection.ClearContents
Range("K4").Select
Selection.ClearContents
Range("M4").Select
Selection.ClearContents
Range("H10").Select
Selection.ClearContents
Range("H16").Select
Selection.ClearContents
TextBox1.Value = ""
End Sub
Sub notebutton1_Click()
Range("K8").Select
Selection.Copy
End Sub
Sub notebutton2_Click()
Range("K13").Select
Selection.Copy
End Sub
Sub notebutton3_Click()
Range("K18").Select
Selection.Copy
End Sub
TextBox1.Value = "" should be accompanied with the form it is living in. So for example Userform1.TextBox1.Value = ""
Related
I have 2 worksheets (Input & Record), I just want to copy some data from "Input" to "Record", it worked but if I protect "Record".... Paste method of Worksheet class Failed comes up.
So I added script for unprotected sheets and protect sheets, but '1004' stil comes up.
Here the detail of my project.
Input sheet is area for me to input some value to a row. In 1 row at least have 10 values at different column.
Maximum row that I can add is ten rows.
Record sheet is database as Table1 based on how much row from Input sheet that i'll add.
Here my script
Sub adddata() 'this sub code from button on "Input" sheet
Sheets("Input").Select
Range("C15").Offset(1, 0).Select 'select range start from C16
If Range("M27") = 1 Then 'value for how much row that i'll add
Range(Selection, Selection.End(xlToRight)).Select
Else
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy
Sheets("Record").Select
Worksheets("Record").Unprotect Password:="4321"
If Range("B2").Offset(1, 0).Value = "" Then
Range("B2").Offset(1, 0).Select
Else
Range("B2").End(xlDown).Offset(1, 0).Select
End If
ActiveSheet.Paste '<< The trouble maker
Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
That I want to know:
What I've missed?
The solution of this dilemma.
I think all this Select process is not necessary and you can avoid that. I can edit my answer if you will add your intentions "what you are trying to do".
You want to copy some range from Input and paste it to Record always to the next empty row?
If I understood you correct, maybe something like this?
Sub adddata()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
Dim NextFreeCell As Range
Set NextFreeCell = ThisWorkbook.Worksheets("Record").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1)
With ThisWorkbook.Worksheets("Input")
If .Range("B2").Value = 1 Then
.Range("C15", .Range("C15").End(xlToRight)).Copy
Else
.Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
End If
End With
NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
ErrorHandler:
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
Here is how it works:
This was not included in your original question. So you have to create a new question with additional information to your original question. However this time I will answer here but not next time.
Here is the code for table:
Sub adddata()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
With ThisWorkbook.Worksheets("Record").ListObjects("Table1").ListRows.Add
With ThisWorkbook.Worksheets("Input")
If .Range("B2").Value = 1 Then
.Range("C15", .Range("C15").End(xlToRight)).Copy
Else
.Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
End If
End With
.Range.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
ErrorHandler:
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
Remove all empty cells in table below your last data. This code will add a new line to table. Also table name should correspond to your table name. Can be found in Excel under Format Table
Try this.
Sub adddata()
Worksheets("Record").Unprotect Password:="4321" ' Unlock the target sheet before copying.
Sheets("Input").Select
Range("C15").Offset(1, 0).Select
If Range("M27") = 1 Then
Range(Selection, Selection.End(xlToRight)).Select
Else
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy
Sheets("Record").Select
If Range("B2").Offset(1, 0).Value = "" Then
Range("B2").Offset(1, 0).Select
Else
Range("B2").End(xlDown).Offset(1, 0).Select
End If
Activecell.PasteSpecial xlAll
Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
When I try to record a macro doing a Vlookup from another sheet, a 1004 error message appears and shows a problem with the first line of the code created.
The error is in the first line:
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'[Suppliers and their bank accounts.xlsx]Sheet1'!C1:C2,2,0)"
Sub Macro4()
'
' Macro4 Macro
'
'
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'[Suppliers and their bank accounts.xlsx]Sheet1'!C1:C2,2,0)"
ActiveSheet.Range("$A$1:$L$431").AutoFilter Field:=3, Criteria1:="="
Range("B2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 6).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.End(xlUp).Select
ActiveSheet.Range("$A$1:$L$431").AutoFilter Field:=3
End Sub
I'm having trouble trying to get this code to work. It does work as intended without the (ByValue Target as Range) portion along with the ActiveCell.Value, but with these included in, I'm getting the error listed.
I have a number of other functions depending on this and would like to see what I could fix.
Thanks a lot!
Private Sub CT(ByVal Target As Range)
'
' CT Macro
'
Sheets("Outbound Tactics").Select
If ActiveCell.Value = "Yes" Then
ActiveCell.Select
Range(Selection, ActiveCell.Offset(0, 23)).Select
Selection.Copy
Sheets("Completed Tactics").Select
ActiveSheet.Range("C4").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Outbound Tactics").Select
ActiveCell.Select
Range(Selection, ActiveCell.Offset(0, 23)).Select
Selection.Delete
End If
End Sub
PS: From what I understand, the beginning portion is there in order to have the macro run continuously without being called in.
Seeing as you don't actually use the Target object in your code I'm assuming you copy/pasted this from somewhere and are not actually sure what it's there for.
Simple answer: remove it.
Private Sub CT()
'// your code here
End Sub
Extended Answer: incorporate it into your code.
Private Sub CT(ByVal Target As Range)
If Target.Value = "Yes" Then
With Sheets("Completed Tactics").Range("C4").End(xlDown).Offset(1, 0)
.Resize(1, 24).Value = Target.Resize(1, 24).Value
.Offset(1, 0).EntireRow.Insert CopyOrigin:=xlFormatFromLeftOrAbove
End With
Target.Resize(1, 24).Delete
End If
End Sub
I have an If statement that runs on the change of a cell. This part works fine. However, when it runs the macro, for some reason it adds is about 40 extra lines. I'v used the breakpoint and discovered that the lines are added in after the the paste special. Can anyone tell me why?
Thanks in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Call CapEx_Copy_Paste_Delete
End If
End Sub
Sub CapEx_Copy_Paste_Delete()
'
' CapEx_Copy_Paste_Delete Macro
'
'
Rows("11:11").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B4:AG4").Select
Selection.Copy
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG4").Select
Selection.ClearContents
Range("B4:E4").Select
Selection.ClearContents
Range("H4:I4").Select
Selection.ClearContents
Range("L4:M4").Select
Selection.ClearContents
Range("P4:Q4").Select
Selection.ClearContents
Range("T4:U4").Select
Selection.ClearContents
Range("X4:Y4").Select
Selection.ClearContents
Range("Z4").Select
Selection.ClearContents
Range("AA4").Select
Selection.ClearContents
Range("AC4").Select
Selection.ClearContents
Range("AD4").Select
Selection.ClearContents
Range("B4").Select
End Sub
Does this work any better??:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Application.EnableEvents = False
Call CapEx_Copy_Paste_Delete
Application.EnableEvents = True
End If
End Sub
Here is the neater version of your code. It's likely all that use of Select isn't helping your problems:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Application.EnableEvents = False
Call CapEx_Copy_Paste_Delete
Application.EnableEvents = True
End If
End Sub
Sub CapEx_Copy_Paste_Delete()
Dim ws As Worksheet
Dim arrRanges As Variant, v As Variant
'set this as the worksheet you want to update
Set ws = ThisWorkbook.Worksheets("Sheet1")
'set this as the ranges you want to clear
arrRanges = Array("AG4", "B4:E4", "H4:I4", "L4:M4", "P4:Q4", "T4:U4", "X4:Y4", "Z4")
With ws
.Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("B4:AG4").Copy
.Range("B11").PasteSpecial Paste:=xlPasteValues
For Each v In arrRanges
.Range(v).ClearContents
Next v
End With
End Sub
Updated to include Gary's Student's suggestion - all credit goes to him for suggesting you disable events in your first sub
I'm using the following VBA code to automate moving a row on one sheet to another. About 1/3 of the time, it gives a "run-time error '-2147417848 (80010108)" and then crashes Excel. I cannot find a common reason why. After a crash, I can execute the same code on the same row, and it may or may not work fine the next time.
Can anyone tell why this code below should be unstable?
Sub Move_to_Sheet2 ()
'
' Move_to_Sheet2 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Rows(ActiveCell.Row).Select
Selection.Copy
Set Rng = Nothing
Sheets("Sheet2").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Sheets("Sheet1").Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.save
End Sub
You need to fully qualify your Rows. See this example.
Sub Move_to_Sheet2()
Dim ws As Worksheet
'~~> Change this to the relevant sheet name
Set ws = Sheets("Sheet1")
With ws
.Rows(ActiveCell.Row).Copy
Sheets("Sheet2").Rows("4:4").Insert Shift:=xlDown
.Rows(ActiveCell.Row).Delete
End With
ActiveWorkbook.Save
End Sub
Sub Test()
' Test Macro
Range("A24:C30").Select
Selection.Copy
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Sheets("Save Sales").Select
Range("B6").Select
Selection.Insert Shift:=xlDown
Sheets("Invoice").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("B9").Select
MsgBox "Print Now"
End Sub