Search code examples
excelfindrangeoffsetvba

FindNext Won't Work With Multiple Dynamic Ranges

What I'm trying to do is add some cell formatting underneath each of my dynamic ranges. I figured I could use a Find and FindNext but the code I've come up with only works for the 1st Dynamic Range. I think the problem that is giving me grief is that the constant I'm using for my Find/FindNext is at the top of my Dynamic Ranges. I then use a End(xlDown).Offset() to get to the cells I want to format.

Here's an example of what I'm starting with for the spreadsheet. Some of the constants are the word "Material" in column B above each section and that the 1st instance will always be in Cell B13 and that the data will never expand beyond Column H. The number of rows in each section will change and the number of sections will change. before macro

This is what I would like it to look like after running the macro! after macro

And here is the code that I've managed to put together. 

Option Explicit
Sub findMaterials()

Dim cRange As Range, cFound As Range
Dim firstAddress As String

Application.ScreenUpdating = False

Set cRange = Cells.Find(What:="Materials", LookIn:=xlValues, _
             LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _
             :=xlNext, MatchCase:=False, SearchFormat:=False) _
             .End(xlDown).Offset(1, 1)
For Each cFound In cRange
    If cFound = cRange Then

    Do

    firstAddress = cRange.Address
    With Range(cRange, cRange.Offset(0, 5))
        .Interior.Color = RGB(149, 179, 215)
        .Font.Color = vbWhite
        .Font.Bold = True
        .Font.Size = 11
    End With
    With Range(cRange, cRange.Offset(0, 4))
        .MergeCells = True
        .HorizontalAlignment = xlRight
    End With

    Set cFound = Cells.FindNext(cFound.End(xlDown).Offset(1, 1))
    Loop While Not cFound Is Nothing And cRange.Address <> firstAddress

    End If

Next cFound
End Sub

I've tried multiple variations that I've found online such as starting with a For i = 12 to lRow above the Set cRange but that didn't seem to work either. So far, I've only gotten the code to find the 1st instance of "Materials" and apply the formatting below the 1st section. Each section has a Header above the word "Materials" that I would like to be in the Subtotal row as well. I imagine I could do that with an array but haven't gotten that far yet and if I have to do some manual entries here and there, I am completely ok with that! Thanks for your help!

Solution

  • Can you give this a try? I don't think the shaded range is correct but that can be easily rectified.

    Sub findMaterials()

Dim cRange As Range, cFound As Range
Dim firstAddress As String

Set cRange = Columns(2).Find(What:="Materials", LookIn:=xlValues, _
             LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _
             :=xlNext, MatchCase:=False, SearchFormat:=False)
If Not cRange Is Nothing Then
    firstAddress = cRange.Address
    Do
        Set cFound = cRange.End(xlDown).Offset(1, 5)
        With cFound
            .Interior.Color = RGB(149, 179, 215)
            .Font.Color = vbWhite
            .Font.Bold = True
            .Font.Size = 11
            .MergeCells = True
            .HorizontalAlignment = xlRight
        End With
        Set cRange = Columns(2).FindNext(cRange)
    Loop While cRange.Address <> firstAddress
End If

End Sub