Re: come on, somebody must know how to do this



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 Work***
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" <Sethaholic.1tgoul_1123531545.6575@xxxxxxxxxxxxxxxxxxxxx> wrote
in message news:Sethaholic.1tgoul_1123531545.6575@xxxxxxxxxxxxxxxxxxxxxxxx
>
> 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 Work***
>
> 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?action=getinfo&userid=25113
> View this thread: http://www.excelforum.com/showthread.php?threadid=393952
>


.


Loading