Macro to hardcode a row based on formula output

[Antonia2345]

Hi,

I have a workbook that contains an excel worksheet, in which each cell in column A (starting from row 16) is a consistent formula returning "Yes" or "No" based on conditions within other worksheets.

I am trying but failing to write a macro that:

a) searches column A for rows containing the formula output "Yes" (I can search successfully for the hardcoded value "Yes", but I can't work out how to search for the formula output "Yes"), and then where it finds "Yes" in Column A, then selects that row and hardcodes the whole row

b) is triggered automatically whenever the output of a formula in column A changes to "Yes"

Can this be done?

Please help!

 

[offthelip]

Welcome to the forum, try this, note you can trigger the macro automatically by putting the call to the macro in the worskseet calculate eventl:

Private Sub Worksheet_Calculate()
Call test
End Sub

Sub test()
Dim temparr() As Variant
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
datarr = Range(Cells(1, 1), Cells(lastrow, lastcol)) 'load the whole worksheet into a variant array
ReDim temparr(1 To 1, 1 To lastcol)
For i = 1 To lastrow
 If datarr(i, 1) = "Yes" Then
  For j = 1 To lastcol
   temparr(1, j) = datarr(i, j) ' copy row to temporary array
  Next j
  Range(Cells(i, 1), Cells(i, lastcol)) = temparr
 End If
Next i

End Sub

 

[Antonia2345]

Thank you for your answer, however this doesn't seem to work. Apologies I am new to vba so can't understand why.


I have found the following code which half works - except it only works if Column A contains hard-coded entries of "1" ... rather than formulas returning the output "1"

Sub formulatovalue()

ActiveSheet.Select

Dim c As Range

For Each c In Columns(1).SpecialCells(xlConstants)

If c.Value = "1" Then

c.EntireRow.Value = c.EntireRow.Value

End If

Next c

End Sub

 

[offthelip]

Try this modification of your code:

Sub formulatovalue()
ActiveSheet.Select
Dim c As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Range(Cells(1, 1), Cells(lastrow, 1))
If c.Value = "Yes" Then
c.EntireRow.Value = c.EntireRow.Value
End If
Next c
End Sub

if you add this to the worksheet code it will make it automatic:

Private Sub Worksheet_Calculate()
Call formulatovalue
End Sub

To add this to the worksheet code right click on the worksheet tab and select "view code" then paste this into the window that appears
My code is rather different because I was using variant arrays which produce much faster code than the technique in the macro you found. This is Ok for a few hundred rows but it it could be a problem if there were thousands of rows. Varaint arrays are often 1000 times faster, whcih change a macro that takes minutes to run into one that takes seconnds.

 

[Antonia2345]

Thank you!

For my understanding, is there a reason for including the following? ...

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Range(Cells(1, 1), Cells(lastrow, 1))


... instead of more simply:

For Each c In Columns(1).Cells

 

[Fluff]

If you used For Each c In Columns(1).Cells then the code would need to look at all 1,048,576 cells in that column, rather than just looking at the used range, so it would take longer to run.

 

[Antonia2345]

thank you!

 

[Fluff]

You're welcome.

 

[Antonia2345]

Sorry to ask a further question - but is there a way to search the range and execute the hardcode row instruction only if in column A the "Yes" is the result of a formula? I've tried messing about with specialcells(xlformulas) but can't get it to work without an error message

The reason I ask is that the code is slow (30 seconds or so to run) even with the range defined as you suggest. I'm wondering if it is taking time hardcoding rows that are already hardcoded ... so can I speed it up by asking vba to look just for cells which are formulas and the output is "Yes"?

 

[Fluff]

How about

Sub Antonia()
   Dim Cl As Range, Rng As Range
   
   On Error Resume Next
   Set Rng = Range("A:A").SpecialCells(xlFormulas)
   On Error GoTo 0
   If Rng Is Nothing Then Exit Sub
   For Each Cl In Range
      If Cl.Value = "Yes" Then
         Cl.EntireRow.Value = Cl.EntireRow.Value
      End If
   Next Cl
End Sub