Consulting

Results 1 to 3 of 3

Thread: Match, Find, Offset & Sum in loop not working

  1. #1
    VBAX Regular
    Joined
    Nov 2018
    Location
    London, U.K.
    Posts
    99
    Location

    Match, Find, Offset & Sum in loop not working

    In my worksheet my data is exactly as shown in attachment.

    For very cell in col R7 to end <> 0, I want to find the first occurrence of the value of Col O7 to End In Col D7 To End.
    Then using offset or similar I want the value of the cell one row below and 5 columns to the right of col D (so for D7 the value in I8,
    for D26 the value in I27 etc) to be the sum of it's value and the value in col R.

    In my data for the first 4 rows in col R, columns I8 = 8323.91, I27 = 37.13, I46 = 12.59 & I65 = 810.79

    So far I've got this code
    Dim DRow As Long
        DRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Dim Brng As Range
        Dim foundcell As Range
        For Each Brng In Range("R7:R" & DRow)
            Set foundcell = Range("D7:D" & DRow).Find(Brng, LookIn:=xlValues, LookAt:=xlWhole)
            If Not foundcell Is Nothing Then
                Cells(foundcell.Row, "I") = rng
            End If
        Next rng
    I'm not even sure this will be worth anything because I'm stuck here. Any advice would be appreciated.
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location

    In my data for the first 4 rows in col R, columns I8 = 8323.91, I27 = 37.13, I46 = 12.59 & I65 = 810.79
    I think your example is wrong for the last two

    For example

    I46 = 12.6 for 1507 and R9 for 1507 = 0.01 making the new I46 = 12.61


    Any way, try this and let me know


    Option Explicit
    
    Sub FiddleNumbers()
        Dim r1 As Range, r2 As Range, rBlanks As Range, rBlank As Range
        Dim nCode As Double, nAdj As Double
        
        Set r1 = ActiveSheet.Range("D7").CurrentRegion
        Set r2 = ActiveSheet.Range("O7").CurrentRegion
        Set rBlanks = r1.Columns(6).SpecialCells(xlBlanks)
    
    
        For Each rBlank In rBlanks.Cells
            nCode = rBlank.Offset(0, -5).Value
            
            nAdj = 0#
            On Error Resume Next
            nAdj = Application.WorksheetFunction.VLookup(nCode, r2, 4, False)
            nAdj = Round(nAdj, 2)
            On Error GoTo 0
            
            rBlank.Offset(1, 0).Value = rBlank.Offset(1, 0).Value + nAdj
        Next
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Regular
    Joined
    Nov 2018
    Location
    London, U.K.
    Posts
    99
    Location
    Thank you Paul! So helpful.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •