Create a Do Loop in an Excel spreadsheet

Hi Guys, can someone write me the code for a Do Loop that loops down Column D in Sheet on the attachment and stops when it hits the Value "PROJECT RIVER HFS" and then copies the value 1 row down and 12 columns to the right, then pastes in Sheet 2,
column B, loop down until the Value is "PROJECT RIVER HFS GBP" and paste Sheet1's Value 4 columns to the right? Justin
Dummy.xls
JustinFinancial ControlAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
I assume when you say "pastes in Sheet 2, column B" that you want me to paste the value to the row on sheet2 where the name matches. However if I paste a value into column B on Sheet2, won't that overwrite the name?
JustincutCommented:
I want to it paste 4 cells to the right so it must find the value "PROJECT RIVER HFS GBP" in column B and then paste to 4 cells of the right there (Currently cell "E50")
Martin LissOlder than dirtCommented:
Four cells to the right of B50 is F50. Do you want the value in E50 or F50?
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Martin LissOlder than dirtCommented:
This is done without looping. It puts the values in column F. To put the values in column E change the "0, 4" in rows 18 and 39 to "0, 3".

Sub FindThem()

Dim rngFound1 As Range
Dim rngFound2 As Range

Application.ScreenUpdating = False
Sheet1.Activate
Set rngFound1 = Cells.Find(What:="PROJECT RIVER HFS", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
        
If Not rngFound1 Is Nothing Then
    Sheet2.Activate
    Set rngFound2 = Cells.Find(What:="PROJECT RIVER HFS", After:=ActiveCell, LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
    If Not rngFound2 Is Nothing Then
        Sheets("Sheet2").Range(rngFound2.Offset(0, 4).Address) = rngFound1.Offset(1, 12)
    Else
        MsgBox "PROJECT RIVER HFS not found in Sheet2"
        Exit Sub
    End If
Else
    MsgBox "PROJECT RIVER HFS not found in Sheet1"
    Exit Sub
End If

Sheet1.Activate
Set rngFound1 = Cells.Find(What:="PROJECT RIVER HFS", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
        
If Not rngFound1 Is Nothing Then
    Sheet2.Activate
    Set rngFound2 = Cells.Find(What:="PROJECT RIVER HFS GBP", After:=ActiveCell, LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
    If Not rngFound2 Is Nothing Then
        Sheets("Sheet2").Range(rngFound2.Offset(0, 4).Address) = rngFound1.Offset(1, 12)
    Else
        MsgBox "PROJECT RIVER HFS GBP not found in Sheet2"
        Exit Sub
    End If
Else
    MsgBox "PROJECT RIVER HFS GBP not found in Sheet1"
    Exit Sub
End If

Application.ScreenUpdating = True

End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Roy CoxGroup Finance ManagerCommented:
I agree that using .Find is better than a Loop, but you don't need to activate the sheets. So adding some slight amnedments the code should run without activating the sheets.

Option Explicit

Sub FindThem()

    Dim rngFound1 As Range
    Dim rngFound2 As Range



    Set rngFound1 = Sheet1.Cells.Find(What:="PROJECT RIVER HFS", After:=Sheet1.Cells(8, 4), LookIn:= _
                                      xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
                                      xlNext, MatchCase:=False, SearchFormat:=False)

    If Not rngFound1 Is Nothing Then

        Set rngFound2 = Sheet2.Cells.Find(What:="PROJECT RIVER HFS", After:=Sheet2.Cells(2, 2), LookIn:= _
                                          xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
                                          xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rngFound2 Is Nothing Then
            Sheet2.Range(rngFound2.Offset(0, 4).Address) = rngFound1.Offset(1, 12)
        Else
            MsgBox "PROJECT RIVER HFS not found in Sheet2", vbInformation, "Not found"
            Exit Sub
        End If
    Else
        MsgBox "PROJECT RIVER HFS not found in Sheet1", vbInformation, "Not found"
        Exit Sub
    End If


    Set rngFound1 = Sheet1.Cells.Find(What:="PROJECT RIVER HFS", After:=Sheet1.Cells(8, 4), LookIn:= _
                                      xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
                                      xlNext, MatchCase:=False, SearchFormat:=False)

    If Not rngFound1 Is Nothing Then

        Set rngFound2 = Sheet2.Cells.Find(What:="PROJECT RIVER HFS GBP", After:=Sheet2.Cells(2, 2), LookIn:= _
                                          xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
                                          xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rngFound2 Is Nothing Then
            Sheet2.Range(rngFound2.Offset(0, 4).Address) = rngFound1.Offset(1, 12)
        Else
            MsgBox "PROJECT RIVER HFS GBP not found in Sheet2"
            Exit Sub
        End If
    Else
        MsgBox "PROJECT RIVER HFS GBP not found in Sheet1"
        Exit Sub
    End If


End Sub

Open in new window

Martin LissOlder than dirtCommented:
Roy, I'm sure your right that with your amendments the code is faster, but with ScreenUpdating set to False, the difference is no doubt infinitesimal.
Martin LissOlder than dirtCommented:
Out of curiosity I used the GetTickCount method from this article of mine on timing code and I ran each of our solutions 100 times. On average yours was about 7.5 ms faster.
Roy CoxGroup Finance ManagerCommented:
IMO it's better to avoid selecting  and activating even on smaller code projects. Also, ScreenUpdating must be switchec back on so I always include an error handler when I use it to ensure that it is switched back on.
Martin LissOlder than dirtCommented:
Actually Screen Updating gets turned back on any time you exit a sub.
Rob HensonFinance AnalystCommented:
Does it have to be VBA routine?

With your sample data the following formula in E50 gets the correct result:

=SUMIFS(Sheet1!$O:$O,Sheet1!$D:$D,$B49,Sheet1!N:N,$A50)

This sums Sheet1 column O where Sheet1 column D is same as B49 (PROJECT RIVER HFS) and Sheet1 column N is same as Currency in column A (GBP).

Thanks
Rob H
scsymeCommented:
Given the nature of the overall workbook this seems like an oddly specific request. Can you put the problem in context so the experts can determine whether there might be a better solution?

For example, is this a workbook that you own and control, or is it something you receive and therefore cannot fiddle with the layout?

As an example of an alternative solution, using the dummy book provided you could enter the following formula into cell E50 of Sheet2 to pull across the number in question:
=SUMIFS(Sheet1!O8:O55,Sheet1!D8:D55,"PROJECT RIVER HFS",Sheet1!N8:N55,"GBP")

Open in new window


It would be neater if you could convert the data in the sheets to use Excel tables.
Martin LissOlder than dirtCommented:
@ JCutcliffe: I've Requested Attention to this thread. What I said in the request was
I'm happy to give more than half of the points to Roy, but I don't think he should get all of them since his answer, while an improvement on mine, is based on my post just above his.
Roy CoxGroup Finance ManagerCommented:
I only intended to point out that selecting and activating isn't necessary, not improve Martin's code - just a different approach.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Spreadsheets

From novice to tech pro — start learning today.