come on, somebody must know how to do this

[Sethaholic]

Here it is again:

Set rngOut = rngOut.Offset(0, 1)
Range(rngOut, _
rngOut.End(xlDown).End(xlToRight)).Copy

rngItem.Offset(0, 2).Insert xlShiftDown


it works, but it only shifts the columns down. I want to shift the entirerow down.
I tried: rngItem.Offset(0, 2).entirerow.Insert xlShiftDown
but it crashed on me. any ideas?? please help!!!

[Sethaholic]

sorry about the title, but i'm so frustrated. i'm so close to finishing, yet so far...

it seems so simple. why can't i get it>!

[Tom Ogilvy]

Sub BBB()
Dim rng As Range
Dim rngItem As Range
Dim rngout As Range
Dim sAdd As String
Set rngItem = Range("A5")
Set rngout = Range("H3")
Set rngout = rngout.Offset(0, 1)
Set rng = Range(rngout, _
rngout.End(xlDown).End(xlToRight))
sAdd = rngItem.Address
rngItem.EntireRow.Resize(rng.Rows.Count).Insert xlShiftDown
rng.Copy Destination:=Range(sAdd).Offset(0, 2)
End Sub

Make sure the data you are copying will not be affected by inserting
entirerows.

--
Regards,
Tom Ogilvy

[Tom Ogilvy]

Aw get real.

You act like your request was clearly stated and unanswered for an extended
period. In fact you said nothing about inserting entire rows. And you
received an answer in about 1.5 hours after you asked. You are posting to
the excel forum which only updates the newgroups where most of the answers
are given on an hourly basis.

Sub BBB()
Dim rng As Range
Dim rngItem As Range
Dim rngout As Range
Dim sAdd As String
Set rngItem = Range("A5")
Set rngout = Range("H3")
Set rngout = rngout.Offset(0, 1)
Set rng = Range(rngout, _
rngout.End(xlDown).End(xlToRight))
sAdd = rngItem.Address
rngItem.EntireRow.Resize(rng.Rows.Count).Insert xlShiftDown
rng.Copy Destination:=Range(sAdd).Offset(0, 2)
End Sub

Make sure the data you are copying will not be affected by inserting
entirerows.

--
Get Real,
Tom Ogilvy

"Sethaholic" <[email protected]> wrote
in message news:[email protected]...
>
> Here it is again:
>
> Set rngOut = rngOut.Offset(0, 1)
> Range(rngOut, _
> rngOut.End(xlDown).End(xlToRight)).Copy
>
> rngItem.Offset(0, 2).Insert xlShiftDown
>
>
> it works, but it only shifts the columns down. I want to shift the
> entirerow down.
> I tried: rngItem.Offset(0, 2).entirerow.Insert xlShiftDown
> but it crashed on me. any ideas?? please help!!!
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile:
http://www.excelforum.com/member.php...o&userid=25113
> View this thread: http://www.excelforum.com/showthread...hreadid=393952
>

[Sethaholic]

i apologize, but yeah, i've actually tried posting several times for the past few weeks, with no response. you are actually the first to respond and i thank you for that.

i'm just very frustrated with my progress, that's all. i know i am very privileged to be using these forums and i sincerely apologize again. excuse me for my behavior, which i know was inappropriate

i am having a hard time understanding your coding though. here's my entire code to make it clearer:

Sub GetPWCPersonnel()

Dim intRec As Integer, rngData As Range, rngItem As Range, rngAccounts As Range, rngout As Range, Dim mysht As Worksheet

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("A71", .Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("Intermediary - PWC").Worksheets("sheet3")
Set rngAccounts = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each rngItem In rngData
Set rngout = rngAccounts.Find(What:=rngItem)

If rngout Is Nothing Then
rngItem.Offset(0, 2).Value = "N/A"

Else
Set rngout = rngout.Offset(0, 1)
Range(rngout, _
rngout.End(xlDown).End(xlToRight)).Copy

rngItem.Offset(0, 2).Insert xlshiftdown

End If
Next rngItem
Next mysht
End Sub


again, all i want to do is copy and paste and make sure it shifts the entire row down. thanks again

[Jim Thomlinson]

Sethaholic... Do not assume that your question is being ignored. Some answers
take longer to formulate than others. If you do not recieve a satisfactory
response withing 4 hours then repost. Looking at Tom's code to write and
debug something like that will take some time. Not to mention Tom has a life
outside this forum (I think). To make things easier on the people supplying
answers make your posts questions and then Select Yes or No to the "Was this
answer helpful". That makes it easier to know if you still neeed assistance
or not.
--
HTH...

Jim Thomlinson


"Sethaholic" wrote:

>
> Here it is again:
>
> Set rngOut = rngOut.Offset(0, 1)
> Range(rngOut, _
> rngOut.End(xlDown).End(xlToRight)).Copy
>
> rngItem.Offset(0, 2).Insert xlShiftDown
>
>
> it works, but it only shifts the columns down. I want to shift the
> entirerow down.
> I tried: rngItem.Offset(0, 2).entirerow.Insert xlShiftDown
> but it crashed on me. any ideas?? please help!!!
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile: http://www.excelforum.com/member.php...o&userid=25113
> View this thread: http://www.excelforum.com/showthread...hreadid=393952
>
>

[Tom Ogilvy]

since you are inserting rows withing the range your looping through, you
can't use a for each construct. You need to loop from the highest numbered
row to the lowest numbered row. Also, as you have shown in your code, when
you insert to rngItem, rngItem gets pushed below the data you are saving. I
hope that is what you want. If not, you would need to do the insertion
below rngItem (but that isn't what you show).

Sub GetPWCPersonnel()

Dim intRec As Integer, rngData As Range
Dim rngItem As Range, sAdd as String
Dim rngAccounts As Range, rngout As Range
Dim mysht As Worksheet
Dim i as Long

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("A71",
Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("Intermediary - PWC").Worksheets("sheet3")
Set rngAccounts = .Range("A1:A" &
Range("A65536").End(xlUp).Row)
End With

For i = rngData.rows(rngData.rows.count).row to _
rngData.row Step -1
set rngItem = rngData.Parent.Cells(i,rngData.column)
Set rngout = rngAccounts.Find(What:=rngItem)

If rngout Is Nothing Then
rngItem.Offset(0, 2).Value = "N/A"

Else
Set rngout = rngout.Offset(0, 1)
Set rng = Range(rngout, _
rngout.End(xlDown).End(xlToRight))
sAdd = rngItem.Address(o,o,xlA1,True)
rngItem.EntireRow.Resize(rng.Rows.Count).Insert xlShiftDown
rng.Copy Destination:=Range(sAdd).Offset(0, 2)
End If
Next i
Next mysht
End Sub

--
Regards,
Tom Ogilvy
"Sethaholic" <[email protected]> wrote
in message news:[email protected]...
>
> i apologize, but yeah, i've actually tried posting several times for the
> past few weeks, with no response. you are actually the first to respond
> and i thank you for that.
>
> i'm just very frustrated with my progress, that's all. i know i am very
> privileged to be using these forums and i sincerely apologize again.
> excuse me for my behavior, which i know was inappropriate
>
> i am having a hard time understanding your coding though. here's my
> entire code to make it clearer:
>
> Sub GetPWCPersonnel()
>
> Dim intRec As Integer, rngData As Range, rngItem As Range,
> rngAccounts As Range, rngout As Range, Dim mysht As Worksheet
>
> Application.ScreenUpdating = False
>
> For Each mysht In ThisWorkbook.Worksheets
> With mysht
> Set rngData = .Range("A71",
> Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
> End With
> With Workbooks("Intermediary - PWC").Worksheets("sheet3")
> Set rngAccounts = .Range("A1:A" &
> Range("A65536").End(xlUp).Row)
> End With
>
> For Each rngItem In rngData
> Set rngout = rngAccounts.Find(What:=rngItem)
>
> If rngout Is Nothing Then
> rngItem.Offset(0, 2).Value = "N/A"
>
> Else
> Set rngout = rngout.Offset(0, 1)
> Range(rngout, _
> rngout.End(xlDown).End(xlToRight)).Copy
>
> rngItem.Offset(0, 2).Insert xlshiftdown
>
> End If
> Next rngItem
> Next mysht
> End Sub
>
>
> again, all i want to do is copy and paste and make sure it shifts the
> entire row down. thanks again
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile:
http://www.excelforum.com/member.php...o&userid=25113
> View this thread: http://www.excelforum.com/showthread...hreadid=393952
>

[Sethaholic]

THANKS TOM!

your explanation was very clear and the coding works to some extent, but I see there is a lot of debugging to do. I still don't get the results i was looking for. To making it more clear, let me illustrate what I have and what I want to have.

I have a bunch of account numbers i.e:

1-11111
2-22222
3-33333
4-44444

When copying the information (personnel) from the other worksheet and pasting it next to rngitem, I want it to look like this:

1-11111 Apples[INDENT]Bananas[INDENT]

Oranges

2-22222 N/A
3-33333 Heaven

Hell

4-44444 Nate

Rob

Allan

This is why I want it to shift the entire row. Is this clearer? The results that I'm getting are not totally what I'm looking for, but I'm trying to work from there. Any ideas on how to fix up the code? Thanks in advance.

[Sethaholic]

Sub GetPWCPersonnel()

Dim intRec As Integer, rngData As Range
Dim rngItem As Range, sAdd As String
Dim rngAccounts As Range, rngout As Range
Dim mysht As Worksheet
Dim i As Long

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("A71", .Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("Intermediary - PWC").Worksheets("sheet3")
Set rngAccounts = .Range("A1:A" & Range("A65536").End(xlUp).Row)
End With

For i = rngData.Rows(rngData.Rows.Count).Row To _
rngData.Row Step -1
Set rngItem = rngData.Parent.Cells(i, rngData.Column)
Set rngout = rngAccounts.Find(What:=rngItem)

If rngout Is Nothing Then
rngItem.Offset(0, 2).Value = "N/A"

Else
Set rngout = rngout.Offset(0, 1)
Set rng = Range(rngout, _
rngout.End(xlDown).End(xlToRight))
sAdd = rngItem.Address(o, o, xlA1, True)
rngItem.EntireRow.Resize(rng.Rows.Count).Insert xlShiftDown
rng.Copy Destination:=Range(sAdd).Offset(0, 2)
End If
Next i
Next mysht
End Sub


WHy doesn't it work correctly....?

[Sethaholic]

NM, i got it to work! Instead of inserting the rows on the rngItem, I inserted the rows one cell below it. But there's something wrong still. It works fine for the first sheet, but somehow it stops working for the other sheets.

I get "N/A" even though it shouldn't for the rest of the accounts. Is there a problem with the "next mysht"? Here's my new code...:

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("A71", .Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("Intermediary - PWC").Worksheets("sheet3")
Set rngAccounts = .Range("A1:A" & Range("A65536").End(xlUp).Row)
End With

For i = rngData.Rows(rngData.Rows.Count).Row To _
rngData.Row Step -1
Set rngItem = rngData.Parent.Cells(i, rngData.Column)
Set rngout = rngAccounts.Find(What:=rngItem)

If rngout Is Nothing Then
rngItem.Offset(0, 2).Value = "N/A"

Else
Set rngcopy = rngout.Offset(0, 1)
Set rng = Range(rngcopy, _
rngcopy.End(xlDown).End(xlToRight))
sAdd = rngItem.Address(o, o, xlA1, True)
Set rngin = rngItem.Offset(1, 0)
rngin.EntireRow.Resize(rng.Rows.Count).Insert xlShiftDown
rng.Copy Destination:=Range(sAdd).Offset(0, 2)
End If
Next i
Next mysht
End Sub