Run script from formula rather than manual cell entry

[Chewyhairball]

Morning folks...well its morning here

I have this code that was kindly produced for me on here.

It does the following:

Replaces all the formulas in a row with the value when the text and also replaces any blank cells with a dash (-)

It does this whenever you manually enter the text 'complete' into a cell in the row.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Modified 6/27/18 5:40 AM EDT
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastcolumn As Long
Dim ans As Long
Dim c As Range
ans = Target.Row
Lastcolumn = Cells(ans, Columns.Count).End(xlToLeft).Column
If Target.Value = "complete" Then
Rows(ans).Value = Rows(ans).Value
For Each c In Range(Cells(ans, 1), Cells(ans, Lastcolumn))
If c.Value = "" Then c.Value = "-"
Next
End If
End Sub
Its a great little code and have been thinking it might also be useful if it could be triggered if instead of the text 'complete' being entered manually but being produced from a formula...eg if(AB30=50,"complete","")

I thought it would be better to start a new thread for this as my last query was answered.

thanks

Rory

 

[Fluff]

Would the value in col AB be entered manually or will that be a formula as well?

 

[Chewyhairball]

Hi. It would be manually entered.

Thanks

 

[Fluff]

In that case you could try

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If Target.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
   If Target.Column <> 28 Then Exit Sub
   If Target.Value = 50 Then
      With Intersect(Target.EntireRow, Sh.UsedRange)
         .Value = .Value
         On Error Resume Next
         .SpecialCells(xlBlanks).Value = "-"
         On Error GoTo 0
      End With
   End If
End Sub

 

[Chewyhairball]

Hi

This isn't exactly what i need. Maybe i shouldn't have put the formula example. I just want the above code to run when 'complete' appears in a column.

At the moment i can type 'complete' and it works but i would like to have it work exactly the same if 'complete' comes from a formula.

thanks

Rory

 

[Fluff]

Change events are not triggered by formulae. One option is to look at the cell that drives the formula, the other is to use a Calculate event, but that that will trigger the macro every time any formula is calculated.

 

[Chewyhairball]

ah! cool. Thats answered that for me. Pity it would have been useful.

What I actually have in that case is an authorised column that when todays date is entered into them triggers the formula to enter complete in the next cell.

What you have given me will work perfect for that although the authorised column is not always the same in each sheet. I think i can manage that...i am assuming 28 refers to AB so i would just need to adjust accordingly.

I would need to replace 50 in the formula with todays date somehow?

Those are the easy sheets...

some of them have 3 authorised columns(triple check) and require 3 entires. With todays date in any of them with dashes in the rest or any permutation of that.

Basically if all 3 columns have been filled out with at least one of them being todays date and the other/s being a -, then the row is complete.

Just now when that happens i can manually type complete in the last row and its fine.

sorry if this is complicated...it makes sense in my head

Rory

 

[Fluff]

This will get you part way there

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim Rng As Range
   If Target.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
   Select Case LCase(Sh.name)
      Case "sheet1", "sheet2"
         Set Rng = Range("AB:AB")
      Case "sheet3"
         Set Rng = Range("AC:AC")
      Case "sheet4"
         Set Rng = Range("AB:AD")
   End Select
   If Intersect(Target, Rng) Is Nothing Then Exit Sub
   If Target.Value = Date Then
      If Rng.Columns.Count > 1 Then
         If Application.CountA(Intersect(Target.EntireRow, Rng)) <> 3 Then Exit Sub
      End If
      With Intersect(Target.EntireRow, Sh.UsedRange)
         .Value = .Value
         On Error Resume Next
         .SpecialCells(xlBlanks).Value = "-"
         On Error GoTo 0
      End With
   End If
End Sub

 

[Chewyhairball]

Thanks very much

Rory

 

[Fluff]

You're welcome