Resize Selected Range Based on Cells Format

[norts55]

My Title for this might not make sense as I do not know all of the VBA terminology. Hopefully I can explain enough for the experts on this forum. I have been helped many times on here and the macro I am trying to modify is one that was given to me in one of my earlier posts. This macro looks thru my sheet in column 5 for the word "Materials" and then does a Offset selection, then modifies the color formatting. This Macro works great but now I need to expand it some. Currently the Resize is always 5 rows. I am finding that I may need 5 rows, 6 rows or even 10 rows throughout my sheet. The only unique thing I can think of to end the last selected row, is the last row has unique borders. Is there a way to resize my selection based on a cells border formatting? So instead of "Resize(5, 1)" I need the macro to find the border formatting I show below and end the selection there. Hopefully someone can help here. I have searched this forum for something similar and have come up empty.

Below is the code and I have attached a image of the cell borders that would be in the last selected row.

Sub Macro1()
'
' Macro1 Macro
'

'
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
  fnd = "Materials"

Set myRange = ActiveSheet.UsedRange.Columns(5)
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(What:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  End If

Set rng = FoundCell.Offset(1, 10).Resize(5, 1)

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
    
    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell.Offset(1, 10).Resize(5, 1))
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Select Cells Containing Find Value
  rng.Select
 
    
    With Selection.Font
        .Color = -16566529
        .TintAndShade = 0
    End With


    
    
End Sub

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[norts55]

Let me know if this helps. I recorded a macro that has the borders I need to be found in the last selected row.

The left and top edges are ".Weight = xlThin", and the bottom and right edges are ".Weight = xlMedium"

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

 

[mumps]

Sorry. That doesn't help. Please see Post #2.

 

[norts55]

Here are a couple of screenshots. Hopefully this is helpful. I need the range to end at a cell that has this format for the borders. Thanks.

 

[mumps]

I understand what you are trying to do but without seeing how the data in your sheet is organized, it is hard to suggest a solution. That is why I asked you to use the XL2BB add-in to attach a screenshot (not a picture) of your sheet or to upload a copy of your file.

 

[norts55]

Hopefully this is helpful....

 

[mumps]

Your picture shows all empty cells Do all the cells including the ranges that you have highlighted in column O contain data? Are there blank rows between each section?

 

[norts55]

Yes, they will contain data, but it will be random. - Some cells will and some cells won't. I am hoping the Data has no bearing on the offset and range selection.

 

[mumps]

Could you please post some sample data which is representative of your actual data. Please try to post a screen shot and not a picture.