Find cell value in column, insert formula five cells right if matches

[vortensis]

Hello all!

Used MrExcel for a while without having to need an account and I've macro'ed hours of time saved until now... I can't figure this one out...

A little back info, I have datasets with sometimes 10,000-30,000 rows of data (luckily only to column J) formulas are required to manipulate this data, so doing this manually is a bit long winded... and until now its always been done manually (why am I the only one to think this could be easier?) So I'm trying to write a macro to offload the worst of the load and save some sanity...

So the question;
Columns A-E have text and dates in, not relevant at this point so lets ignore them... Easy to manually format these as needed so not relevant and already a macro done for these...
Column F has numbers, only numbers. The important ones...

I'd like to check all of Column F for the value "42", on the rows with cell values of "42" insert a formula five cells to the right, and another one six cells to the right of the cells found on each row...
Sounded a lot simpler to me when I thought of it...

Sub FormulaOn42s(strSearchQuery As String)
Set SearchRange = ActiveWorkbook.ActiveSheet.Range("F:F")
    FindWhat = "42"
    Set FoundCells = FindAll(SearchRange:=SearchRange, _
                            FindWhat:=FindWhat, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            MatchCase:=False, _
                            BeginsWith:=vbNullString, _
                            EndsWith:=vbNullString, _
                            BeginEndCompare:=vbTextCompare)
    If FoundCells Is Nothing Then
        MsgBox "42 not found."
    Else
        For Each FoundCell In FoundCells
            FoundCell.ActiveCell.Select
            ActiveCell.FormulaR1C5 = "=HEX2DEC()+850"
            ActiveCell.FormulaR1C6 = "=HEX2DEC()+1125"
        Loop
    End If
End Sub

But obviously that's not working, which is why I'm here...

Any ideas on how to achieve this?

Thanks in advance,

Vortensis.

 

[Joe4]

Welcome to the Board!

.FormulaR1C1 is not where you enter the offset. That is fixed, and just tells it that you are entering the code in "R1C1" format.
To offset, you would start like this:

ActiveCell.Offset(0,5).FormulaR1C1 = ...

 

[vortensis]

Welcome to the Board!

.FormulaR1C1 is not where you enter the offset. That is fixed, and just tells it that you are entering the code in "R1C1" format.
To offset, you would start like this:

ActiveCell.Offset(0,5).FormulaR1C1 = ...

Thanks for educating me there, I have updated the code accordingly and although it didn't solve the entire problem it did lead to some decent progress, the code no longer errors (huzzah!) and works fine... but only last found row matching the criteria of "42"...

This is what the code now looks like... (with more help from Scott Huish - How to use Cells.Find function to search only in one column?)

Sub Formulaon42s()
Dim c As Range, FoundCells As Range
Dim firstaddress As String
Application.ScreenUpdating = False
With ActiveSheet
    Set c = Range("H2:H65536").Find(What:="42", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            If FoundCells Is Nothing Then
                Set FoundCells = c
            Else
                Set FoundCells = Union(c, FoundCells)
                
            End If
            Set c = .Cells.FindNext(c)
        Loop While Not c Is Nothing And firstaddress <> c.Address
        FoundCells.Select
            ActiveCell.Offset(0, 7).FormulaR1C1 = "=HEX2DEC()+850"
            ActiveCell.Offset(0, 8).FormulaR1C1 = "=HEX2DEC()+1125"
    Else
        Range("A1").Select
        MsgBox "42 not found :("
    End If
End With
Application.ScreenUpdating = True
End Sub

Is there any change I can make to make this insert the formulas for each cell that matched 42?
Although I have picked up a fair bit on this already this bit is still eluding me...

thanks in advance,

vortensis

 

[Joe4]

Borrowing from this code here: Find All Instances With VBA — TheSpreadsheetGuru, you could modify to work for you like this:

Sub FindAll()

'PURPOSE: Find all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com

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 = "42"

Set myRange = Range("H:H")
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
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'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)
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Select Cells Containing Find Value
  rng.Offset(0, 7).FormulaR1C1 = "=HEX2DEC()+850"
  rng.Offset(0, 8).FormulaR1C1 = "=HEX2DEC()+1125"
  
Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"

End Sub

 

[vortensis]

Borrowing from this code here: Find All Instances With VBA — TheSpreadsheetGuru, you could modify to work for you like this:

Sub FindAll()

'PURPOSE: Find all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com

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 = "42"

Set myRange = Range("H:H")
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
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'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)
   
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
     
  Loop

'Select Cells Containing Find Value
  rng.Offset(0, 7).FormulaR1C1 = "=HEX2DEC()+850"
  rng.Offset(0, 8).FormulaR1C1 = "=HEX2DEC()+1125"
 
Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"

End Sub

Hi Joe4,

Utterly amazing, I've adapted the code you supplied and its now working perfectly!
Thanks again, definitely marked as answer!

vortensis

 

[Joe4]

Utterly amazing, I've adapted the code you supplied and its now working perfectly!
Thanks again, definitely marked as answer!

You are welcome!
Glad we were able to get it all to work out for you.