Results 1 to 10 of 604

Thread: Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10

    Appendix to ..

    Post to support this Thread:
    http://www.excelfox.com/forum/showth...0888#post10888
    _1) This part of Rick’s solution
    Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow))


    I have seen something similar to this before, but it is lost to mankind hidden down in the comment section of a Blog site, Allen Wyatt’s I think…… so its nice that something like this has seen the light of day here…
    Quote Originally Posted by Rick Rothstein View Post
    If I am not mistaken, this non-looping macro should also work...
    Code:
    Sub ThisShouldWork() Dim LastRow As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("A1:A" & LastRow) = Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow)) Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete End Sub
    To help simplify the explanation, lets take it that we know our range , ( http://www.excelfox.com/forum/showth...-row#post10870 ) so we have LastRow = 40
    Two arbitrarily chosen characters, @ and # , are being used to enter into the main formula the LastRow or LastRow +1
    Pseudo like we are doing this sort of thing
    Replace( “A#” , “#” , “40” ) in order to end up with like “A40”
    By inspection of the main formula, and with a bit of eye straining you can probably see where you replace those @ and # with 40 and 41
    Just to be sure , running this will get you a nice copy able version of the main formula in the immediate window , ( after running you Hit Ctrl+g from the VB Editor to get the immediate window up):
    Code:
    Sub ThisShouldWork()
    Dim LastRow As Long, strEval As String
     Let LastRow = Cells(Rows.Count, "A").End(xlUp).Row
     Let strEval = Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow)
     'Range("B1:B" & LastRow).FormulaArray = "=" & strEval
     Debug.Print strEval  'IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A40&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40,""))
    That did work.JPG : https://imgur.com/01sQ91X

    _._______________________-
    Before moving on a useful note: It is always useful when developing these formulas to view the string in the Immediate window: That can help with tricky syntaxes : The formula seen on the Immediate window must look like a formula in the same syntax as you would manually type it into a cell. So you can see immediately if you get something wrong , such as an error in the finally seen quotes.
    _.__________________________
    So we have our final formula:
    IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A40&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40,""))
    The way these formulas appear to work within the Evaluate(“ “) appears to be tapping into an along the columns , down a row, then along the columns… type updating raster to update a worksheet. The available output then seems to be that which encompasses the deepest and widest ranges. It is a ,little bit more complicated than that ( http://www.excelfox.com/forum/showth...on-and-VLookUp ) , but for our formula we have nice regular equally sized ranges so we are expecting an output of 1 “wide” and 40 “deep”. So for analysis purposes, we can reduce the formula to 40 similar ones.

    Lets take the example of the formula for the 13th “down” output ..
    IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13&" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
    Clearly we need to look at this data to see what that formula will do, because this data is used in that formula
    _____ Workbook: NormanOrrinRickFilter.xlsm ( Using Excel 2007 32 bit )
    Row\Col
    A
    13
    2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah,
    14
    10006098, 15392.64
    Worksheet: Rick

    We have some nested IFs , and I find it is always a good idea to break those down so that we can start doing them as Excel or VBA would do them, that is to say from the middle working outwards. I tend to do this in a text editor with a horizontal scroll bar, or in the VB Editor window
    Formula in VB Editor as comment.JPG : https://imgur.com/3cjyqSR

    So this is what we have, broken down into the constituent IF sections.
    ( It may be better to copy this and view in your VB Editor in a wide window. I am working from the bottom , upwards )
    Code:
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"") , IF(LEFT(A13,4)="2018",A13,"") )
    ' IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
    Examining the first line , I can evaluate the two innermost IFs and reduce the formula to
    Code:
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), TRIM(A13" "&A14) , A13 ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) 
    I will now evaluate some of those SUBSTITUTEs
    ( Excel Substitute, seems to work similarly to VBA Replace )
    Code:
    ' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 ) 
    ( I am guessing that 0+ will ensure that a number will not be mistaken as a text )

    For the case of the 13th “down” formula the final steps in the evaluation go as follows
    Code:
    ' 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
    ' TRIM(A13" "&A14)
    
    ' IF( True , TRIM(A13" "&A14) , A13 )
    Here are all the steps together again
    Code:
    ' 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
    ' TRIM(A13" "&A14)
    
    ' IF( True , TRIM(A13" "&A14) , A13 ) 
    
    
    ' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 ) 
    
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), TRIM(A13" "&A14) , A13 ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) 
    
    
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) 
    ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"") , IF(LEFT(A13,4)="2018",A13,"") )
    ' IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
    The final result will appear in the 13th down position of the 40 “deep” array final results for the entire formula evaluation.
    If you can view that last summary on a wide window, it should be able to see how the differing results for the other 39 results are achieved from the formula
    Just to make clear once again what seems to go on in these sort of Evaluate formulas, in the next post is a table showing the actual Evaluateions done by VBA

    _._____

    _2 The final part of Rick’s solution is
    Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete
    This uses the VBA SpecialCells Method to get at the cells with nothing in them. Those are then deleted
    Explanation:
    VBA SpecialCells Method ( https://www.mrexcel.com/forum/excel-...onditions.html , https://docs.microsoft.com/en-us/off...e.specialcells ) returns you a range object ( that range object must not be contiguous ( connected ) cells ) consisting of those cells meeting a specific characteristic. We can choose from a number of characteristics. Here we choose xlBlanks , which refers to the characteristic of the cell being empty. So, if we applied that .SpecialCells(xlBlanks) to this range:.._
    Row\Col
    B
    9
    10
    11
    2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5
    12
    2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72
    13
    2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
    14
    15
    2018, 1, 90765, 10012123, P4, Ch of Blabla(Blabla of Blabla), CHE, BLA-BLA,Bla Blabla, 10005678, 16231.7

    _ … then the returned range from that would be Range(“B9:B10,B14”).
    If we then apply .Delete to that range then those cells are removed. If you remove a cell via .Delete then initially there is a real hole, like a “black hole” that can’t really exist in a spreadsheet. So Excel might explode or implode, or you would be sucked into that hole , never to return!!! To prevent that happening, Excel shifts all cells to close that hole, ( and adds a new virgin cell at the bottom or right side to fill the indent there caused by the shift. The default Delete option for the direction of that shift is in our case upwards. Hence after applying the .Delete after applying .SpecialCells(xlBlanks) to the above range, ( pseudo like doing something this Range(“B9:B10,B14”).Delete(Shift:=xlUp) ) we will be left with
    Row\Col
    B
    9
    2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5
    10
    2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72
    11
    2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
    12
    2018, 1, 90765, 10012123, P4, Ch of Blabla(Blabla of Blabla), CHE, BLA-BLA,Bla Blabla, 10005678, 16231.7
    13
    14

    What has happened there is the following: Those empty cells ( which were yellow ) have been removed. Other cells have been shifted up to fill up the “holes” created by the removal
    ( Rick’s code line actually deletes the EntireRow of that row on which the empty cells are found )

    _.______________________________________________

    Just to make clear once again what seems to go on in these sort of Evaluate formulas, in the next post is a table showing the actual Evaluateions done by VBA

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    Full demo code to accompany last post:
    Code:
    Option Explicit
    Sub ThisShouldWork()
    Dim LastRow As Long, strEval As String
     Let LastRow = Cells(Rows.Count, "A").End(xlUp).Row
     Let strEval = Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow)
     Debug.Print strEval ' Hit Ctrl+g from the VB Editor to get the Immediate window up.                                                                                              'IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A40&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40,""))
    'This is the spreadsheet equivalent to Rick's Evaluate
     Range("B1:B" & LastRow).FormulaArray = "=" & strEval
    'This gives a demo of the actual formulas that Excel VBA does
     Range("J5:J44").Value = "=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2,"" "",""""),"","","""")),IF(LEFT(A1,4)=""2018"",TRIM(A1&"" ""&A2),""""),IF(LEFT(A1,4)=""2018"",A1,""""))" ' Applying the fixed vector notation (Excel instructed to do that by no $s) will result in the same relative formula. Displayed will be the actual formula ( in the relative form, but that is not important)
      
    ' Final solution  Rick : http://www.excelfox.com/forum/showthread.php/2293-Move-values-in-rows-at-the-end-of-the-preceding-row?p=10888#post10888
      Range("A1:A" & LastRow) = Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow))
    '  Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete ' This will mess up now due to my .FormulaArray  as you can't delete bits of that
    End Sub
    
    
    
    '          2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
    '                        TRIM(A13" "&A14)
    
    '   IF(      True        ,   TRIM(A13" "&A14)        ,       A13       )
    
    
    '   IF(       ISNUMBER(0+1000609815392.64),   TRIM(A13" "&A14)        ,       A13       )
    '   IF(       ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")),   TRIM(A13" "&A14)        ,       A13       )
    
    '   IF(       ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),   TRIM(A13" "&A14)        ,       A13       )           )
    '   IF(       ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018"  ,  TRIM(A13" "&A14)  ,  "")      ,     IF( LEFT(A13,4)="2018"  ,  A13  ,"" )     )
    
    
    '   IF(       ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018"  ,  TRIM(A13" "&A14)  ,  "")      ,     IF( LEFT(A13,4)="2018"  ,  A13  ,"" )     )
    '      IF(       ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"")      ,     IF(LEFT(A13,4)="2018",A13,"")     )
    '            IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
    and here it is again ... in "Ricks Table Code Tags" ( http://www.excelfox.com/forum/showth...0902#post10902 )
    Code:
    Option Explicit Sub ThisShouldWork() Dim LastRow As Long, strEval As String Let LastRow = Cells(Rows.Count, "A").End(xlUp).Row Let strEval = Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow) Debug.Print strEval ' Hit Ctrl+g from the VB Editor to get the Immediate window up. 'IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A41," ",""),",","")),IF(LEFT(A1:A40,4)="2018",TRIM(A1:A40&" "&A2:A41),""),IF(LEFT(A1:A40,4)="2018",A1:A40,"")) 'This is the spreadsheet equivalent to Rick's Evaluate Range("B1:B" & LastRow).FormulaArray = "=" & strEval 'This gives a demo of the actual formulas that Excel VBA does Range("J5:J44").Value = "=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2,"" "",""""),"","","""")),IF(LEFT(A1,4)=""2018"",TRIM(A1&"" ""&A2),""""),IF(LEFT(A1,4)=""2018"",A1,""""))" ' Applying the fixed vector notation (Excel instructed to do that by no $s) will result in the same relative formula. Displayed will be the actual formula ( in the relative form, but that is not important) ' Final solution Rick : http://www.excelfox.com/forum/showthread.php/2293-Move-values-in-rows-at-the-end-of-the-preceding-row?p=10888#post10888 Range("A1:A" & LastRow) = Evaluate(Replace(Replace("IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2:A#,"" "",""""),"","","""")),IF(LEFT(A1:A@,4)=""2018"",TRIM(A1:A@&"" ""&A2:A#),""""),IF(LEFT(A1:A@,4)=""2018"",A1:A@,""""))", "#", LastRow + 1), "@", LastRow)) ' Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete ' This will mess up now due to my .FormulaArray as you can't delete bits of that End Sub ' 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64 ' TRIM(A13" "&A14) ' IF( True , TRIM(A13" "&A14) , A13 ) ' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 ) ' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 ) ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), TRIM(A13" "&A14) , A13 ) ) ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")), IF(LEFT(A13,4)="2018" , TRIM(A13" "&A14) , "") , IF( LEFT(A13,4)="2018" , A13 ,"" ) ) ' IF( ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),"") , IF(LEFT(A13,4)="2018",A13,"") ) ' IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A14," ",""),",","")),IF(LEFT(A13,4)="2018",TRIM(A13" "&A14),""),IF(LEFT(A13,4)="2018",A13,""))
    remember to scroll down first to find the scroll bar:
    Scroll down to find Ricks Code bar.JPG : https://imgur.com/R3jgXek
    Attachment 2136
    Attached Images Attached Images

Similar Threads

  1. Testing Concatenating with styles
    By DocAElstein in forum Test Area
    Replies: 2
    Last Post: 12-20-2020, 02:49 AM
  2. testing
    By Jewano in forum Test Area
    Replies: 7
    Last Post: 12-05-2020, 03:31 AM
  3. Replies: 18
    Last Post: 03-17-2019, 06:10 PM
  4. Concatenating your Balls
    By DocAElstein in forum Excel Help
    Replies: 26
    Last Post: 10-13-2014, 02:07 PM
  5. Replies: 1
    Last Post: 12-04-2012, 08:56 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •