Inserting A selection before another

**Link Strife** · 01-11-2005, 06:55 PM

The task that I wish to complete is not a simple one for me, maybe I can ask one of you veterans how to do it.

My problem is this, I have a group of cells, say A1 to D5. I need to take this selection and paste them into a new area near the bottom of the sheet before a "Summary" set of rows. So to attempt to show you what I need to do.
____A_______B_________C__________D_______
1 |Project #|Priority #|People involved|Hours worked|
2 |________|_______| Name_______|___ 7 ______|
3 |________|______ | Name _______|___ 4 _____|
4 |________|______ | Name _______| ___ 3 _____ |
5 |________|_______| Name_______|____ 7_____ |
6 Need to take selection and "copy and insert" here
7 ____________________________________________
8 |________|________|___Summary__| Total hours ___|
9 |________|________|Name________| hours________|
10 |________|________|Name________| hours________|
11 |________|________|Name________| hours________|
12 |________|________|Name________| hours________|

Just normally copying is easy, inserting at the bottom before the Summary is easy, that is if you do it manually.

I am attempting to set up a macro that will check the columns and insert it automatically. I was thinking of either checking the "C" column and inserting the selection right after it or searching the sheet for the word "Summary" and inserting the selection right above it. I just don't know how to set up the macro to do it for me.

An entirely seperate problem that I will be having next is, how do I get the "total hours" column to update to include the hours of the newly inserted rows?

Any help is apprieciated and please excuse my horrible art

Link S

**anilsolipuram** · 01-11-2005, 07:34 PM

below code is searching for "summary" and inserts copied cells of "a1:d5" next row after it finds "summary" text.

Sub macro()
On Error GoTo a:
Dim k As Integer
k = 1
Cells.Select
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
k = 2
a:

If k = 1 Then
Range("a1").Select
MsgBox "no summary found"
Else
i = ActiveCell.Row
Range("a1:d5").Select
Selection.Copy
Range("a" & (i + 1)).Select
ActiveSheet.Paste
End If
End Sub

I guess total hours can be calculated by selecting the cell, where you want the result and using the code, activecell.formula='"=sum("d2":d" & lastrow)" , last row can be calculated using code
range("d2").select
Selection.End(xlDown).Select
lastrow=ActiveCell.Row

**Link Strife** · 01-12-2005, 10:47 AM

Thanks I will use this right away.

Link S

**Link Strife** · 01-12-2005, 12:13 PM

Ok thanks to what anilsolipuram gave me yesterday I managed to get this far, had to modify it a bit to make it work correctly.
Notice at the bottom I am using most of his formula to help me get this far, but now I need to know. Is there an easier way to clear cell contents? As you can see at the bottom I have K, L, M and N clearing, but I still need to go all the way to Column AL, and instead of having a couple pages worth of cell clearing I was wondering if there was a way to clear K to AL easily?
Sub InsertRows()

' InsertRows Macro
' Macro recorded 1/11/2005 by darnel_gobeil
On Error GoTo a:
Dim k As Integer 'setting up k, k is nothing more then a true/false check
k = 1 'our test number
Cells.Select 'must study more to figure out exactly what this means
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
k = 2 'but once its done searching for the word "summary" it changes k to 2
a:

If k = 1 Then 'so if summary is NOT found then k is still equal to 1
'and when its tested and executes the If part
Range("a1").Select 'highlights a1
MsgBox "no summary found" 'lets the user know that "summary" was not found
Else 'if "summary" was found then k is equal to 2
i = ActiveCell.Row
Range("a6:aj12").Select 'selects the top project
Selection.Copy 'copies it
Range("a" & (i - 1)).Select 'goes to where summary is, and moves 1 above it
Selection.Insert Shift:=xlDown 'puts the top project in
'then the user is asked for the Projects Number, Priority number and name
Range("a" & (i - 1)).Value = InputBox("What is the Project Number?")
Range("b" & (i - 1)).Value = InputBox("What is the Priority Number?")
Range("c" & (i - 1)).Value = InputBox("What is the Projects Name?")
End If 'clearing the contents of k
Range("k" & (i + 0)).ClearContents
Range("k" & (i + 1)).ClearContents
Range("k" & (i + 2)).ClearContents
Range("k" & (i + 3)).ClearContents
Range("k" & (i + 4)).ClearContents
Range("k" & (i + 5)).ClearContents
'clearing the contents of l
Range("l" & (i + 0)).ClearContents
Range("l" & (i + 1)).ClearContents
Range("l" & (i + 2)).ClearContents
Range("l" & (i + 3)).ClearContents
Range("l" & (i + 4)).ClearContents
Range("l" & (i + 5)).ClearContents
'clearing the contents of m
Range("m" & (i + 0)).ClearContents
Range("m" & (i + 1)).ClearContents
Range("m" & (i + 2)).ClearContents
Range("m" & (i + 3)).ClearContents
Range("m" & (i + 4)).ClearContents
Range("m" & (i + 5)).ClearContents
'clearing the contents of n
Range("n" & (i + 0)).ClearContents
Range("n" & (i + 1)).ClearContents
Range("n" & (i + 2)).ClearContents
Range("n" & (i + 3)).ClearContents
Range("n" & (i + 4)).ClearContents
Range("n" & (i + 5)).ClearContents

End Sub

**anilsolipuram** · 01-12-2005, 12:19 PM

Range("k" & i & ":AL" & (i+5) ).Select
Selection.ClearContents

this code will clear contents from ki:AL(i+5) range

**Link Strife** · 01-12-2005, 01:14 PM

Dude you are a God send!

Link S

**Link Strife** · 01-13-2005, 11:08 AM

Alright so far so good, managing to get as far as I can, I have run into a new snag though.

When I update my "Summary" column to include the newly added Project, I find that it tends to use this formula, yes I admit I used the recorder before seeing you guys. When it updates it adds the newest project, but then it drops the top most project, slowly all the top projects get excluded while the new ones remain. How do I get the top project to remain? Is there a way to contine adding the newest project without losing the oldest/topmost? Here is my code so far. Don't stare to long, it will boggle the eyes. The part that is red is the code that drops the previous project. Thanks in advance.

Sub InsertRows()

' InsertRows Macro
' Macro recorded 1/11/2005 by link_strife
On Error GoTo a:
Dim k As Integer 'setting up k, k is nothing more then a true/false check
k = 1 'our test number
Cells.Select 'must study more to figure out exactly what this means
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
k = 2 'but once its done searching for the word "summary" it changes k to 2
a:

If k = 1 Then 'so if summary is NOT found then k is still equal to 1
'and when its tested and executes the If part
Range("a1").Select 'highlights a1
MsgBox "no summary found" 'lets the user know that "summary" was not found
Else 'if "summary" was found then k is equal to 2
i = ActiveCell.Row
Range("a6:ai12").Select 'selects the top project
Selection.Copy 'copies it
Range("a" & (i - 1)).Select 'goes to where summary is, and moves 1 above it
Selection.Insert Shift:=xlDown 'puts the top project in
'then the user is asked for the Projects Number, Priority number and name
Range("a" & (i - 1)).Value = InputBox("What is the Project Number?")
Range("b" & (i - 1)).Value = InputBox("What is the Priority Number?")
Range("c" & (i - 1)).Value = InputBox("What is the Projects Name?")
End If
'clears the contents from K to AL
Range("k" & i & ":AI" & (i + 5)).Select
Selection.ClearContents
'then re-adds the borders ^_^;;
Selection.Borders(xlEdgeLeft).Weight = xlMedium
Selection.Borders(xlEdgeTop).Weight = xlHairline
Selection.Borders(xlEdgeBottom).Weight = xlMedium
Selection.Borders(xlEdgeRight).Weight = xlHairline
Selection.Borders(xlInsideVertical).Weight = xlHairline
Selection.Borders(xlInsideHorizontal).Weight = xlHairline

Cells.Select 'begins searching for summary again
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate

i = ActiveCell.Row
Range("k" & (i + 1)).Select 'goes to where summary is, and moves 1 below it
ActiveCell.FormulaR1C1 = _
"=R[-78]C+R[-71]C+R[-64]C+R[-57]C+R[-50]C+R[-43]C+R[-36]C+R[-29]C+R[-22]C+R[-15]C+R[-8]C"
Range("k" & (i + 1)).Select
Selection.AutoFill Destination:=Range("K" & (i + 1) & ":K" & (i + 6)), Type:=xlFillDefault
Range("k" & (i + 1)).Select
Selection.AutoFill Destination:=Range("k" & (i + 1) & ":AI" & (i + 1)), Type:=xlFillDefault
Range("k" & (i + 1) & ":AI" & (i + 1)).Select
Range("k" & (i + 2)).Select
Selection.AutoFill Destination:=Range("k" & (i + 2) & ":AI" & (i + 2)), Type:=xlFillDefault
Range("k" & (i + 2) & ":AI" & (i + 2)).Select
Range("k" & (i + 3)).Select
Selection.AutoFill Destination:=Range("k" & (i + 3) & ":AI" & (i + 3)), Type:=xlFillDefault
Range("k" & (i + 3) & ":AI" & (i + 3)).Select
Range("k" & (i + 4)).Select
Selection.AutoFill Destination:=Range("k" & (i + 4) & ":AI" & (i + 4)), Type:=xlFillDefault
Range("k" & (i + 4) & ":AI" & (i + 4)).Select
Range("k" & (i + 5)).Select
Selection.AutoFill Destination:=Range("k" & (i + 5) & ":AI" & (i + 5)), Type:=xlFillDefault
Range("k" & (i + 5) & ":AI" & (i + 5)).Select
Range("k" & (i + 6)).Select
Selection.AutoFill Destination:=Range("k" & (i + 6) & ":AI" & (i + 6)), Type:=xlFillDefault
Range("k" & (i + 6) & ":AI" & (i + 6)).Select
Selection.Borders(xlEdgeBottom).Weight = xlMedium

End Sub

**anilsolipuram** · 01-13-2005, 01:51 PM

I am not sure if this is what you are looking for.

I think your question is to not overwrite the old projects data.

I added this logic to go last active row (row with data) after summary

If CStr(Range("k" & (i + 1)).Value) <> "" Then ' logic to go to the last active row after summary
If CStr(Range("k" & (i + 2)).Value) <> "" Then
Range("k" & (i + 1)).Select
Selection.End(xlDown).Select
Else
End If
Else
End If

Sub InsertRows()

' InsertRows Macro
' Macro recorded 1/11/2005 by link_strife
On Error GoTo a:
Dim k As Integer 'setting up k, k is nothing more then a true/false check
k = 1 'our test number
Cells.Select 'must study more to figure out exactly what this means
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
k = 2 'but once its done searching for the word "summary" it changes k to 2
a:

If k = 1 Then 'so if summary is NOT found then k is still equal to 1
'and when its tested and executes the If part
Range("a1").Select 'highlights a1
MsgBox "no summary found" 'lets the user know that "summary" was not found
Else 'if "summary" was found then k is equal to 2
i = ActiveCell.Row
Range("a6:ai12").Select 'selects the top project
Selection.Copy 'copies it
Range("a" & (i - 1)).Select 'goes to where summary is, and moves 1 above it
Selection.Insert Shift:=xlDown 'puts the top project in
'then the user is asked for the Projects Number, Priority number and name
Range("a" & (i - 1)).Value = InputBox("What is the Project Number?")
Range("b" & (i - 1)).Value = InputBox("What is the Priority Number?")
Range("c" & (i - 1)).Value = InputBox("What is the Projects Name?")
End If
'clears the contents from K to AL
Range("k" & i & ":AI" & (i + 5)).Select
Selection.ClearContents
'then re-adds the borders ^_^;;
Selection.Borders(xlEdgeLeft).Weight = xlMedium
Selection.Borders(xlEdgeTop).Weight = xlHairline
Selection.Borders(xlEdgeBottom).Weight = xlMedium
Selection.Borders(xlEdgeRight).Weight = xlHairline
Selection.Borders(xlInsideVertical).Weight = xlHairline
Selection.Borders(xlInsideHorizontal).Weight = xlHairline

Cells.Select 'begins searching for summary again
Selection.Find(What:="summary", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
i = ActiveCell.Row 'goes to where summary is
If CStr(Range("k" & (i + 1)).Value) <> "" Then ' logic to go to the last active row after summary
If CStr(Range("k" & (i + 2)).Value) <> "" Then
Range("k" & (i + 1)).Select
Selection.End(xlDown).Select
Else
End If
Else
End If
i = ActiveCell.Row ' goes to last active row after summary
Range("k" & (i + 1)).Select 'goes to next row
ActiveCell.FormulaR1C1 = _
"=R[-78]C+R[-71]C+R[-64]C+R[-57]C+R[-50]C+R[-43]C+R[-36]C+R[-29]C+R[-22]C+R[-15]C+R[-8]C"
Range("k" & (i + 1)).Select
Selection.AutoFill Destination:=Range("K" & (i + 1) & ":K" & (i + 6)), Type:=xlFillDefault
Range("k" & (i + 1)).Select
Selection.AutoFill Destination:=Range("k" & (i + 1) & ":AI" & (i + 1)), Type:=xlFillDefault
Range("k" & (i + 1) & ":AI" & (i + 1)).Select
Range("k" & (i + 2)).Select
Selection.AutoFill Destination:=Range("k" & (i + 2) & ":AI" & (i + 2)), Type:=xlFillDefault
Range("k" & (i + 2) & ":AI" & (i + 2)).Select
Range("k" & (i + 3)).Select
Selection.AutoFill Destination:=Range("k" & (i + 3) & ":AI" & (i + 3)), Type:=xlFillDefault
Range("k" & (i + 3) & ":AI" & (i + 3)).Select
Range("k" & (i + 4)).Select
Selection.AutoFill Destination:=Range("k" & (i + 4) & ":AI" & (i + 4)), Type:=xlFillDefault
Range("k" & (i + 4) & ":AI" & (i + 4)).Select
Range("k" & (i + 5)).Select
Selection.AutoFill Destination:=Range("k" & (i + 5) & ":AI" & (i + 5)), Type:=xlFillDefault
Range("k" & (i + 5) & ":AI" & (i + 5)).Select
Range("k" & (i + 6)).Select
Selection.AutoFill Destination:=Range("k" & (i + 6) & ":AI" & (i + 6)), Type:=xlFillDefault
Range("k" & (i + 6) & ":AI" & (i + 6)).Select
Selection.Borders(xlEdgeBottom).Weight = xlMedium

End Sub

**Link Strife** · 01-13-2005, 02:13 PM

I think by now anilsolipuram I would need to send you my project, so you can get a better look at it. You have done much for me already and I wonder how, if at all I can repay you.

**anilsolipuram** · 01-13-2005, 03:03 PM

is your question resolved.

**Link Strife** · 01-13-2005, 04:14 PM

No unfortunatly, when I use your code it brings the summary and then collides with the "vacation" column, my part is very basic coding and yours is a great distance beyond me.

What I am attempting to accomplish is this
- with the push of the toolbar button "New Project (Manny)", it will copy the first project and go to the bottom of the entire sheet. (yes this means there needs to be a project to begin with, I will set it up to prompt the user for a first project later.
- there it prompts the user to enter a project number, priority number and project name, when completed it will paste the first project with the new information and clear the cells of the first projects information.
- going down to the "summary" section it will take all the current cells used in the calculation and add the newly created cells to the formula. For example, the summary of "Cam McLoud" had cells D7, D14, D21 and D28. I just made a new project and thus made a new entry for Cam on D35. Now the summary table is out of date because it is not including this new cell. The macro is supposed to recognize that this new project is to be added and update the formula accordingly. My attempt to use the recorder failed because is uses a reverse count method, counting down from the summary cell.
- Finanlly, set up a new toolbar button to automatically take the projects and sort them by Prioity number.

Yeah, you have managed to help me get this far, I feel bad about asking you to help me further, but as I have said, its beyond me.

contact me via email at [email protected]
I will reply and send you the spreadsheet if need be.

Thanks again anilsolipuram

Link S

Inserting A selection before another

LinkBack

Thread Tools

Rate This Thread

Display

Inserting A selection before another

clearing the next part

I think by now

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions