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]

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.

 

[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.

 

[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.

 

[Sethaholic]

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

i'm just very frustrated with my progress, that's all. i know i am ver
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 m
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 th
entire row down. thanks again :

 

[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

 

[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 th
results i was looking for. To making it more clear, let me illustrat
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 an
pasting it next to rngitem, I want it to look like this:

1-11111 Apples
Bananas

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? Th
results that I'm getting are not totally what I'm looking for, but I'
trying to work from there. Any ideas on how to fix up the code? Thank
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,
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 th
other sheets.

I get "N/A" even though it shouldn't for the rest of the accounts. I
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 Su