Find Something > Go Up 'N' Rows > Paste > Find Another Something > etc.

[NeverHappyMike]

Hi

I'm updating multiple sheets that contain the same structure - 4 tables, one below the other, numbered rows from 50-250 and 7 columns. Above each table is a slightly different title, but each table has the same column headings. (see attached file)

I had recorded myself using the find and replace function and had started to try to integrate that into a working macro. But it seemed too specific.

I thought I might try looking at how I can use the fixed structure of these sheets to my advantage - and as a learning tool.

I have used a previous macro example (thanks NARAYANK991) to find the first number 50, however I'm not sure how you work back from there to select the cell 2 rows above it, paste in a value from an array, and then iterate through finding the remaining 3 other 50 values pasting in the next value from my array.

My code something below is pure make-believe, and copied from other macros. But I hope it gives you an idea of what I'm thinking of doing. I hope that looking at the issue this way would allow me to use what I learn on other problems I will face in the future.

Any help or advice you can give would be really appreciated.

Thanks
Mike.

Sub Find50()
Dim FoundCell2 As Range
Dim strNewValues as String
Dim strSearchForFifity as String

strSearchForFifity = Array("50", "50", "50", "50")
    For I = 0 To UBound(strNewValues)
    For I = 0 To 4
strNewValues = Array("Value 1", "Value 2", "Value 3", "Value 4")
    For I = 0 To UBound(strNewValues)
    For I = 0 To 4
With ActiveSheet
Set FoundCell2 = .Range("$A:$A").Find(strSeachForFifity(I), Range("A1"), xlValues, , xlByRows)
FoundCell2.Select
FoundCell2.Range(FoundCell-2Rows).
ActiveCell.FormulaR1C1 = strnewValue (I)
Next FoundCell2
End With
         
End Sub

 

[Luke M]

Hi Mike,

You're right, it's definitely something.

I think I was able to figure it out. See if this is what you're looking for.

Sub Find50()
Dim fCell As Range
Dim strNewValues() As Variant
Dim strSearch As String
Dim i As Long
Dim recCount As Long
Dim firstAdd As String

'What are we looking for?
strSearch = 50
strNewValues = Array("Value 1", "Value 2", "Value 3", "Value 4")

recCount = 0

Application.ScreenUpdating = True
Set fCell = Cells.Find(strSearch)

'Check if any cells match
If Not fCell Is Nothing Then
    firstAdd = fCell.Address
   
    Do
        fCell.Offset(-2).Value = strNewValues(recCount)
        recCount = recCount + 1
        Set fCell = Cells.FindNext(fCell)
    Loop Until fCell.Address = firstAdd
End If

'Just as a FYI
MsgBox "Cells found: " & recCount

Application.ScreenUpdating = True
End Sub

 

[NeverHappyMike]

Hi Luke.

Yep, it was something.

I simply pasted your code in and ran it. Unfortunately there are some strange outcomes. I've uploaded a file I ran the macro on, and highlighted (yellow) where it pasted the values, compared to where I thought it would (green).

I also received this message:"Subscript out of range".

I wondered if it was worth restricting the search to $A:$A, as the 4 occurrences of 50 should only be looked for in that column.

Anyway, thanks for your time with this enquiry.

 

[Luke M]

I notice that you want cell A26 to change, but cell A28 says 51, not 50. Was this expected? The cells that got changed in error was because I forgot to tell the Fin to do a whole cell match, and it found the number "50" within the decimal portion. oops.

Ammeded code:

Sub Find50()
Dim fCell As Range
Dim strNewValues() As Variant
Dim strSearch As String
Dim i As Long
Dim recCount As Long
Dim firstAdd As String

'What are we looking for?
strSearch = 50
strNewValues = Array("Value 1", "Value 2", "Value 3", "Value 4")

recCount = 0

Application.ScreenUpdating = True
Set fCell = Cells.Find(strSearch, , , xlWhole)

'Check if any cells match
If Not fCell Is Nothing Then
    firstAdd = fCell.Address
   
    Do
        fCell.Offset(-2).Value = strNewValues(recCount)
        recCount = recCount + 1
        Set fCell = Cells.FindNext(fCell)
    Loop Until fCell.Address = firstAdd
End If

'Just as a FYI
MsgBox "Cells found: " & recCount

Application.ScreenUpdating = True
End Sub

Alternatively, if we're just changing table names, we could take a different approach.

Sub AlternatePlan()
Dim fCells As Range
Dim c As Range
Dim strNewValues() As Variant
Dim recCount As Long


recCount = 0
strNewValues = Array("Value 1", "Value 2", "Value 3", "Value 4")

'Find table headers
On Error Resume Next
Set fCells = Intersect(Range("A:A"), Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0

Application.ScreenUpdating = False
If fCells Is Nothing Then Exit Sub
'Loops through headers and change names
For Each c In fCells
    c.Value = strNewValues(recCount)
    recCount = recCount + 1
Next c
Application.ScreenUpdating = True

End Sub

 

[NeverHappyMike]

Hi Luke.

I've used your amended original code and it works great. It's done exactly what I tried to explain.

I didn't try your alternative code because I fear it's actually looking for a table heading (.SpecialCells), whereas the files I am working on have make-believe headings, as they are not real Excel tables, just rows and columns.

I'm now going to try and use your code as a foundation to help me work out how to change the column headings as well: variable.Offset(-2,1)? and iterate through that as well, but using a different variable.

Your help and expertise has been very helpful.

Thanks
Mike.

 

[Luke M]

You're welcome. I would say, the Special Cells is not looking for "table headings". In an XL workbook, if you hit Ctrl+g, and then hit Special, you can see the types of cells XL can find quickly. What I'm doing in the code is scanning col A for cells that are constants (not created by a formula) and have text. Based on your sample, this criteria gave me all the headers. Does that make sense?