Full demo code to accompany last post:
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: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,""))
Scroll down to find Ricks Code bar.JPG : https://imgur.com/R3jgXek
Attachment 2136
Reply With Quote
Bookmarks