none
VB: Test a Cell if "IS" a formula instead of just "Has" formula text in cell RRS feed

  • Question

  • update:  i have a function i am trying to use to help determine if a cell IS a formula.  its problem is that it uses the same "Has" formula function.  is there a way to fix this udf to test fif cell is an actual formula instead of having a copy of a non-functioning formula, mixed in with notes.

    in a column,  most rows are notes records with some backups of formulas pasted in the notes cells.  The HAS formula idea gets a false positive.

    need help to fix this UDF to test if a cell is actually a formula.  not sure it will work as i have written it: 

    Function IsFormula(checkCELL As RANGE) 'NO  (TEST does not include true if only has a copy of a formula, but still fails in a vb run)

        IsFormula = checkCELL.HasFormula    'is this correct adding a second item like this, next line:
        IsFormula = Left(checkCELL.Formula, 1) = "="    'not sure how make both lines work/ if this is good answer or not?

        'Left(activecell.Formula, 1) = "="
        'USE AS:  If IsFormula(Selection) Then  'If IsError(Selection) Then    'hasformula() funny, can have a formula copy in cell for a false reading

    'isform() isformula()
    End Function

    XXXXXXXXXX    Other:

    a work around devised..  does not fix the "is" formula problem, but to test my unique items, is:  (problem had with all items in 1 line, the test would not work,  but this does)

     

              If rCell.HorizontalAlignment = xlCenter And rCell.Value <> "." Then    'workcell J5 shows:  M:M
              If Left(Cells(rCell.row, RANGE(J5).Column).Formula, 10) = "=HYPERLINK" Then   
                  'your vb
              End If: End If


    a sample of notes, getting a false positive on below.  eg does not even have =HYPERLINK in it.  the result is for "my vb" item pasting over the cell, when it should not.  notes eg:  (this cell has a formula, but is not a formula itself).

    EG NOTES     X1111    
    item x provides x, etc.  notes
    =IF(D9>0.005,IF(D9>0.01,"Z","Y"),IF(D9>0.003,"A",IF(D9>0.0005,"B","C")))

    other notes





    • Edited by Davexx Sunday, June 11, 2017 5:59 AM
    Friday, June 9, 2017 11:38 PM

Answers

  • Hi Davexx,

    What do you mean has formula text but not is a formula? I tried but failed to save formula text to a cell without setting it as a formula. When will you get a false positive?

    ->'not sure how make both lines work/ if this is good answer or not?

    You could make judge twice to combine these two line code. Like this

    Function IsFormula(checkCELL As Range)
        IsFormula = False
        If checkCELL.HasFormula Then
        IsFormula = Left(checkCELL.Formula, 1) ="="
        End If
    End Function

    What's the value in Cells(rCell.row, RANGE(J5).Column)? Since you said this cell is not a formula itself, so how the cell could use Formula property? Please tell me more details about the cell with formula text so we could try to reproduce your issue.

    Best Regards,

    Terry

    • Marked as answer by Davexx Wednesday, June 14, 2017 7:16 AM
    Monday, June 12, 2017 7:43 AM

All replies

  • Hi Davexx,

    What do you mean has formula text but not is a formula? I tried but failed to save formula text to a cell without setting it as a formula. When will you get a false positive?

    ->'not sure how make both lines work/ if this is good answer or not?

    You could make judge twice to combine these two line code. Like this

    Function IsFormula(checkCELL As Range)
        IsFormula = False
        If checkCELL.HasFormula Then
        IsFormula = Left(checkCELL.Formula, 1) ="="
        End If
    End Function

    What's the value in Cells(rCell.row, RANGE(J5).Column)? Since you said this cell is not a formula itself, so how the cell could use Formula property? Please tell me more details about the cell with formula text so we could try to reproduce your issue.

    Best Regards,

    Terry

    • Marked as answer by Davexx Wednesday, June 14, 2017 7:16 AM
    Monday, June 12, 2017 7:43 AM
  • hi,  thanks !!  that worked.  pardon i might not write so well for being, novice? vb.  functions are still new to me - i'll work on that.  i thought saw examples of making a 'same' variable? =  two things & i did not work the boolean this required.

    i looked all over the net for an answer.  what found/ had was not complete.  yours was easy enought to test with:  MsgBox IsFormula(activecell)

    Answer to your Question:  rcell  etc.  i have a great tool for pasting formulas-formats-all,  down a column eg at:

    https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-mso_winother/vb-answer-automatically-paste-formulas-down-a/e609ad57-e27d-450d-9e4c-2c95546aac5b

    (SEE EG AT Bottom of this post / line id'd:  PROBLEM / now fixed).  for this post for pasting links down only specific columns that are only pasted at header rows (cannot use Left(A:A) <> "." there.  that example is similar to above link,  but i had some trouble. 

     

    whats funny is the amount of time i am spending on reviewing vb i have to experiment "alot".  with MANY parts, this is part of a loop for pasting down a column just in work rows that have:  =HYPERLINK( etc  in them.  since this is mostly a notes column, i could not isolate those lines.  PROBLEM:  my loop vb was pasting over notes in record lines.  I found a work around to test cells

    looks like i deleted a text example.  its just a notes column / cell where i might paste a formula from same row if something changed.. nothing special (not matter much?)  eg:

    ----------  my isformula udf   FALSE POSITIVE ON:

    AQSVD    N1103    MISS:  x    ,120315    xx  (120823)  1:10  120/10=12
    110923    (110919)    :120319    ;120915  gd?

    =IF(DT1650>12,IF(DT1650>90,"05/01/2009",IF(DT1650>50,"10/01/2009",IF(DT1650>22,"02/01/2010",IF(DT1650>16,"11/01/2010","04/01/2011")))),IF(OR(DT1650>5,1),"01/01/2013",IF(OR(DT1650>1.5,1),"12/01/2015","12/01/2015")))

    ----------

    ==========    alternate pasting formulas down a column for section header rows & not each record line.  mostly using if column x = column x.  (edited copy example,  not directly tested).  this work is from countless hours of testing etc.

    this not all directly related to answer needed, but pasting links.. etc autmatically can save alot of time.

     

     

    '2 examples here,  bottom item was problem
    Sub altLOUT()    'LINKS  (alt-L for paste links down a column),  thisworkbook as:  application.OnKey "%{l}", "altL"        'a-l  paste links groups by spec lines
        Dim G8 As String: G8 = RANGE("G8")  'example work cells reference to columns value = eg:  "M:M"
        Dim H4 As String: H4 = RANGE("H4")  'G8 has:  SUBSTITUTE(SUBSTITUTE(CELL("address",$DI$23),"$",""),"","")
        Dim J4 As String: J4 = RANGE("J4")  'column  (work cells)
        Dim J5 As String: J5 = RANGE("J5")  'column
        Dim M8 As String: M8 = RANGE("M8")  'M8 has:  =SUBSTITUTE(SUBSTITUTE(CELL("address",$BG$138),"$",""),"","")

       

    'H4 has column:  =SUBSTITUTE(SUBSTITUTE(CELL("address",$AS4),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$AS4),"$",""),ROW(),"")

          
        Dim r As Long, c As Long, rCell As RANGE, LastRow As Long
        r = activecell.row: c = activecell.Column: LastRow = Cells(Rows.Count, 1).End(xlUp).row  'find last row used
        RANGE("A1").Value = vbNullString: RANGE("A2").Value = vbNullString    ''safety: if a1>0 then macros on
        
    On Error Resume Next
        If activecell.row <= RANGE(G8).row Or Left(Cells(activecell.row, "A:A").Text, 1) <> "." Then application.EnableEvents = True: Exit Sub ': goMODE: Exit Sub 'E7 top G8 hdr
        If application.CutCopyMode <> xlCopy Then MsgBox "NOT IN COPY MODE, try again", vbQuestion: Exit Sub
        application.EnableEvents = False: application.ScreenUpdating = False    'EVENTS  must have  UPDATE   screen jump
        
        Dim msg As String, Ans As Variant             'safety feature
        msg = "RUN PASTE-OP?" & vbCr & "CK B4 SAVE, BU FILE FIRST"         'MsgBox "line1" & vbCr & "line2"
        'Ans = MsgBox(Msg, vbYesNo + vbQuestion + vbDefaultButton2, "Watch Your Paste Column")   'hilite "no" by button2
        Ans = MsgBox(msg, vbYesNo + vbQuestion, "Watch Your Paste Column")   'hilite "yes"
        'Ans = MsgBox(Msg, vbYesNo)    'hilite "yes"
        Select Case Ans
        
        
        Case vbYes        'your code    'MsgBox "Macro Works", vbquestion
          
    'MAIN LINKS (no formula test)
          If selection.Column >= RANGE(H4).Column And selection.Column <= RANGE(J4).Column Then   'EQ & MAIN LINKS
            For Each rCell In RANGE(Cells(r, c), Cells(LastRow, c))
    'DISCERN:
              If Left(Cells(rCell.row, "A:A").Text, 2) = ".x" Then          'yes    <<  CANNOT USE ROW ID SPEC BELOW
                rCell.Select
                selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
              End If
            Next rCell
            RANGE("A1").Value = ".": RANGE("A2").Value = ".": application.CutCopyMode = False: application.EnableEvents = True               'EVENTS
            RANGE(Cells(RANGE(M8).row, selection.Column), Cells(Rows.Count, activecell.Column).End(xlUp)).RESIZE(, selection.Columns.Count).Calculate    'YES as: .select or .calculate  in a row: all cols selected from 'top row' to bottom
            
            
            
            
    'PROBLEM:  ISFORMULA pending
    'UPLINKS >>  PROBLEM FIXED WITH WORK AROUND !!  (hasformula vs isformula problem)
          ElseIf 1 And selection.Column = RANGE(J5).Column Then             'UP LINK ATTEMPT
            For Each rCell In RANGE(Cells(r, c), Cells(LastRow, c))
            
    'DISCERN:  PROBLEM LINE:    IF ISFORMULA WILL GO IN HERE AS?:  and isformula(rcell)
              If rCell.HorizontalAlignment = xlCenter And rCell.Value <> "." Then
              If Left(Cells(rCell.row, RANGE(J5).Column).Formula, 10) = "=HYPERLINK" Then    'PASTES OVER SOME RECS, prob includes? too many tests in 1 line.  (now fixed here, this works)
                
                rCell.Select
                selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False    'paste all
              End If: End If
            Next rCell
            RANGE("A1").Value = ".": RANGE("A2").Value = ".": application.CutCopyMode = False: application.EnableEvents = True               'EVENTS
            RANGE(Cells(RANGE(M8).row, selection.Column), Cells(Rows.Count, activecell.Column).End(xlUp)).RESIZE(, selection.Columns.Count).Calculate    'YES as: .select or .calculate  in a row: all cols selected from 'top row' to bottom
            
            
          Else
            MsgBox "Out of Range, Move selection to range of LINKS", vbQuestion: application.EnableEvents = True: Exit Sub
          End If
          
        
        Case vbNo                       'YN part 2, case to quit
            GoTo QUIT:
        End Select
    QUIT:
        application.EnableEvents = True               'EVENTS
    End Sub






    • Edited by Davexx Wednesday, June 14, 2017 8:59 AM
    Wednesday, June 14, 2017 8:20 AM