Collectives™ on Stack Overflow
Find centralized, trusted content and collaborate around the technologies you use most.
Learn more about Collectives
Teams
Q&A for work
Connect and share knowledge within a single location that is structured and easy to search.
Learn more about Teams
I greatly appreciate anyone who can help me fix my code.
I am very new to VBA and tried adapting the code below to work for my excel document. Unfortunately, I keep running into Error '1004' stating my selection to copy is to big for the are I want to paste it. I have search for days now and have no idea how to fix the code "Debug" tells me is wrong, Selection.Insert Shift:=xlDown.
My spread sheet tracks progress on projects and when a project is completed (this is identified with the date the documents are signed) the entire row describing the project is move down below a header "Completed".
When a new project is initiated I have a "create New Project" button that inserts a new row above the existing projects that are still being worked on.
My codes
:
Sub Worksheet_Change(ByVal Target As Range)
'This Sub tranfers correspondence from the in progress line down underneath the completed line once a date is entered in the decision date column.
If Target.Column = 23 Then
If Target.Value <> "" Then
Target.EntireRow.Select
Application.CutCopyMode = False
Selection.Interior.Color = RGB(255, 220, 200)
Selection.Cut
'Locates the "completed" section and moves the cursor to just below the headings
Cells.Find(What:="*Completed*", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(2, 0).Range("A1").Select
Selection.Insert Shift:=xlDown
MsgBox ("Did you remember to upload all documents to shared drive")
End If
End If
End Sub
AND.....
Sub Insert()
' Insert Macro
'Insert row above Row 5
Rows(6).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
–
Will try to help clean this; haven't tested the code, but should be pretty straightforward, since you want to start with a whole row then end with a whole row:
Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(23)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Dim r as Long, i as Long
If Target.Value <> "" Then
r = ActiveCell.Row
With Rows(r)
Application.CutCopyMode = False
.Interior.Color = RGB(255, 220, 200)
End With
'Locates the "completed" section and moves the cursor to just below the headings
i = Cells.Find(What:="*Completed*", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Rows(i+2).Insert Shift:=xlDown
MsgBox ("Did you remember to upload all documents to shared drive")
End If
End If
End Sub
I am confused by your line:
ActiveCell.Offset(2, 0).Range("A1").Select
What were you trying to do? The code I modified has the row being inserted 2 below the Completed cell row.
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.