[FONT=Arial][size=3] [color="#3E0000"]
Using Windows Management Instrumentation (WMI)
Why?
[FONT=Arial][size=3] [color="#3E0000"]
Using Windows Management Instrumentation (WMI)
Why?
Last edited by DocAElstein; 01-07-2020 at 02:52 AM.
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
4, 5, 6 and 7 data section output after running Sub SpltTests() from http://www.excelfox.com/forum/showth...0881#post10881
https://tinyurl.com/yd95w5v2
_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )
Worksheet: Result
Row\Col
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
iiziuziuziuzkgjgjhhggjjg
Last edited by DocAElstein; 01-08-2020 at 01:25 AM.
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
Main Routine in support of these Threads Part 1
http://www.excelfox.com/forum/showth...0893#post10893
http://www.eileenslounge.com/viewtopic.php?f=21&t=31572
The coding is split into 2 parts to fil it into a Forum Post. But this and the coding in the next post form a single routine. That forms the main routine. In addition, a routine Called by the Main routine is required, Public Sub GetElemsText( ) , which is posted in the over next post.
Code:Option Explicit Sub EP() ' http://www.excelforum.com/showthread.php?t=1148621&page=7&p=4452110&highlight=#post4452110 Rem 1)File Info 'Dim wsLkUp As Worksheet: Set wsLkUp = ThisWorkbook.Worksheets("Tabelle1"): wsLkUp.Activate Dim strURL As String ' File with Page ' file:///G:/Excel0202015Jan2016/OffenFragensForums/eileenslounge/XP/Updates/report.html Let strURL = ThisWorkbook.Path & "\Updates\" & "report.html" ' '"http://www.ernaehrung.de/lebensmittel/de/W233000/Fleischkaese.php" ' "http://www.ernaehrung.de/lebensmittel/de/W233000/PloppyPooFukYou" ' Application.Wait Now + TimeValue("00:00:02") ' Rem 2) ' '2a xmlHTTP stuff MSXML2.XMLHTTP.6.0 IXMLHTTPRequest Alan: "simple xml request here, so you could give URL a simple File of the HTML code" 'Dim Request As Object: Set Request = CreateObject("MSXML2.XMLHTTP") 'Late Inding https://msdn.microsoft.com/en-us/library/ms759148(v=vs.85).aspx Dim request As MSXML2.XMLHTTP: Set request = New MSXML2.XMLHTTP 'Early Binding Requires --- TOOLS --- REFERENCES -- tick Microsoft XML, v6.0 http://www.mrexcel.com/forum/excel-questions/759592-help-createobject-msxml2-xmlhttp-macro.html 'Application.Cursor = xlWait'cursor disable..just to be on the safe side??? With request '(or With CreateObject("msxml2.xmlhttp"))'By virtue of GET this is a simplified "xml" request .Open bstrmethod:="GET", bstrURL:=strURL, varasync:=True ' ("GET", strURL, True) 'just preparing the request type, how and what type. The second argument determines type. This may then require further info in next lines Only diferrence to pike's and Kyle's opening and sending stuff is argument:- Leith: "The True/False argument of the HTTP Request is the Asynchronous mode flag. If set False then control is immediately returns to VBA after Send is executed. If set True then control is returned to VBA after the server has sent back a response. I prefer to use asynchronous mode and test if my timeout period has expired to prevent the code from hanging due to an unresponsive server. In the example I provided I used synchronous mode to reduce the amount the code and keep it easier to understand." 'No extra info here for type GET ' ' '.setRequestHeader "DNT", "1" '.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" ' Content-Type is the property name, x-www-form-urlencoded is the value (content type in the html is "text/html" not "x-www-form-urlencoded" - that is something diifferent) You can have different request header properties and pass different values. This isn't unusual, just not required in this case When you POST data to a server, you need to tell it what format you are sending it in. So the Type of Content sent in the body of the request (the send bit) is application/x-www-form-urlencoded .setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo" .send ' varBody:= ' No extra info for type GET. .send actually makes the request While .readyState <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option Dim PageSrc As String: Let PageSrc = .responseText ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc. The responseText property returns the information requested by the Open method as a text string End With Set request = Nothing ' This section is finished. We no longer need the Library. Optionally can therefore Set request = Nothing, a step most appropriate if required for some reason. Previous arguments of good practice to prevent memory leaks and data corruption appear outdated in favour of only using when a good reason is apparent to avoid masking when it is a good idea. '_..EP2ab Explicit Pedantry. We intend using PagrSrc through a method to produce a model Object Orientated stylio for later use through use of its Methods and Properties. This model is frequently referred to as a Document Orientated Model, DOM. Some steps in this creation of the "DOM" can frequently be confused with the processes in '2a which are in fact now finished. Part of the .Send , "finishes all processes. We move on to '2b. Only PagrSrc is required to be "taken over" as it were '2b DOM stuff' Make OOP type model of HTML code, using Microsoft HTML Office Library 'Dim HTMLdoc As HTMLDocument: Set HTMLdoc = New HTMLDocument 'Early binding - will not work with .Write:- Leith "This is a case where late binding has to be used. The htmlfile is an ActiveX object that is a wrapper function for the IHTMLDocument2 interface in MSXML2. This gets into a lot of low level system operation......." https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba-2.html#post4031122 https://www.excelforum.com/excel-programming-vba-macros/1214789-late-binding-2.html#post4820307 'Early binding TOOLS >>> REFERENCES >>Microsoft HTML Object Library Dim HTMLdoc As Object: Set HTMLdoc = CreateObject("htmlfile") 'Late Binding, ' Create an empty HTML Document. HTMLdoc.Open 'EP2b(i) This clears the values in the HTMLdoc. Complete Explicit Pedantry. in usage outside VBA, Methods for an instance will often be required which require a clearing of an instance before "using". Approximately in VBA this can be considered putting the DOM back to as if it were at the point just before it is given "loaded" with the PageSrc String. Effectively in VBA doing a pair of Set = Nothing , with either a Dim and Create Dom or Set = New type code line It serves no purpose usually in VBA. Effectively we reset a situation back to as it is. It can however be used through .Open HTMLdoc.Write PageSrc 'EP2b(ii). Convert the HTML code into an HTML Document Object Model, DOM 'give it somehow the info it needs to work further? ---- Fills the DOM HTML .. Wiki Dom http://www.excelforum.com/showthread.php?t=1148621&page=3#post4441761 'HTMLdoc.body.innerHTML = PageSrc ' Most people do that, but The Write method of an HTML file is designed to convert the page source text into an HTML DOM document. Both methods achieve the same results. The more common way Body of the Page Source code when converting it to an HTML DOM document oustside of VBA. Withiin VBA it just works harder to achieve the same. This excludes the Meta data, Java scripts, and Class information from being converted. Generally speaking, this information is not used when retrieving only text data from a web page. HTMLdoc.Close 'EP2b(iii) _ 2 b or not in 2b , that was the ?? http://www.excelforum.com/showthread.php?t=1148621&page=6.. Briefly When used outside VBA, some processes started by .Open() can or should be finished after the corresponding outside VBA .write(). This is done using .Close(). Once again this can be used in VBA through .Close. It has no conceivable merit or known as yet reason to use it in VBA. Pike thinks it It closes the document you have just written. As such he describes it as optional. He would also not have the HTMLdoc.Open. Kyle thinks nothing is open. Leith uses it but has made no comment to Date. This may be just his style, like my EP's just not including the HTMLdoc.Open 'EP2b(i) Rem 3 Rem 3a) Directly
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
This is required for the single Main routine which is posted in two parts in the last two posts
[Code]'2 Alan http://www.excelforum.com/showthread.php?t=1148621&page=3#post4441761
'5 Leith Ross http://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-visual-basic-applications-2.html#post4031122
'10 '....' "This is a recursive procedure to extract text from between an element's start tag and end tag and everything in between. Usually the Calling program will have passed a HTML code ( either from, for example, a .HTML File, a .Tex File, a .txt file, or from a returned such file after a request to a web page) into a Document Object Model. ( DOM ). This somehow organises things in a tree type structure , approximately as like you might see if you carefully indented the HTML code yourself, such that tag pairs were clear to see within tag pairs, each level down as it were. ( a "next level down" is often referred to as a "Child" ). The exact structure is less obvious, but in any case the DOM will have some ordered structure and every constitute part of the code is referred to as an Element. In a simple case most Elements have a start and stop pointed bracket. They are all nodes. Text is usually squeezed in between somewhere within a paired tag set, but is also referred to as a node.
'12 'I think a node is a point, usually a junction point in the tree type structure. Usually before the procedure is run a first time, an Element will have been obtained from the DOM and this is to be passed in the signature line of the procedure, as an Object. VBA then makes a Copy of the procedure and runs that with the given Element.
'15 'The macro will examine this Element Object brought in for a Text Node: If the element .NodeType is not 3 (a text node) then there are possibly child nodes ( Nodes "next down" in a Tree type listing ) that need to examined. The procedure then "Calls itself". In other words the first Copy stops at the Call Point. At the Call point another Copy of the procedure is made and runs in a loop for each child node.
'20 'The next Copy of the macro will again examine the element for a Text Node. If found (If element node type is 3), the text is concatenated with the ElemText String. If this is the ElemText string is empty then ElemText is set to this value. If not then this value is concatenated with any previous text and separated by a tilde character. This character can be used later to parse the text string into the individual strings from each element. The macro will exit the Sub at this point. When this happens, this copy of the macro is "removed from the call stack", in other words it Ends, and the last Copy continues from the Call point at which it was stopped.
Public Sub GetElemsText(ByRef Elem As Object, ByRef ElemText As String) 'It takes an Object, (variable Elem), a HTML Element, or a ( child ) node thereof. (Wiki says "An HTML element is an individual component of an HTML document or web page, once this has been parsed into the Document Object Model. (DOM). HTML is composed of a tree of HTML Elements and other nodes, such as text nodes." May be close to but not excactly what you se by carefully indenting down "Child" levels
'25 Dim strobjElem As String: Let strobjElem = TypeName(Elem)' http://www.excelforum.com/excel-programming-vba-macros/1149427-vba-determine-object-type-from-html-dom-object-put-type-in-string-variable-as-shown-in.html
65 Rem 1) Do we have an Element
70 If Elem Is Nothing Then GoTo LEndSub [color=darkgreen]'If the Object Elem is empty, or rather we are not given one, Then we End
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
Part 2 of Main code.
This coding in this post should be copied diretly under the coding from the last post. Together they form a single routine, the Main routine
(The routine, Public Sub GetElemsText( ) , which is posted in the next post is also required for the Main routine to work )
Code:Rem 3a) Directly ' ' ' Simple text file print out using just result of PageSrc from '2a Debug.Print PageSrc ' unfortunately you will unlikely be able to view the whole String as it appears too big. Also pasting to a cell will not make it all visible. However if after pasting the .value from the cell is put in a string and that used in place of Pagesrc in the creation of the DOM it does work, so indicating that the data is there, but just not possible for us to "see". Dim strTextFile As String: Let strTextFile = ThisWorkbook.Path & "\Updates\strTextFile.txt" Dim HghWyNo2 As Long: Let HghWyNo2 = FreeFile(RangeNumber:=1) Open strTextFile For Binary As #HghWyNo2 Put #HghWyNo2, 1, PageSrc ' Use Put to write the whole array at once http://www.vb-helper.com/howto_read_write_binary_file.html https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/put-statement Close HghWyNo2 ' ' ' 'Application.Cursor = xlDefault' Restore the cursor to normal. Rem 3b) Large Object from main made OOP type model object, (HTMLdoc) ( Rem 3b)(i) ) ' Dim Head As Object 'Dim Head As IHTMLElementCollection 'requires Early Binding. getElementsBy___ returns a NodeList which is an interface to the DispHTMLElementCollection which is an internal class that you're not supposed to see/use. It does implement the IHTMLElementCollection though so you can use that. Dim Head As Object ' Unusually this Large main Object is Dim ed as an Object, ..as you find you cannot Dim it as what its TypeName( ) returns ( or as displayed in the Watch Window ), “DispHTMLElementCollection“ . Set Head = HTMLdoc.getElementsByTagName("Table") 'This Object is a massive thing again with loads in, but this time it would appear to be the things "tagged" with < table > < /table > which look like the headings of each table I am interested in Rem 4)(Rem 3b)(ii)) Often we would loop here for each "Table" but in our example we only have one 'Dim oTable As THMLTable ' If we had Early binding, then this would work, because omehow Head has been recognised as a table oTable as HTMLTable.JPG : https://imgur.com/R309JjC , and for ..._ Dim oTable As Object ' _... this table we have typically present in the object ' HTML TableRow count , "column" Count for final Table will need to be calculated, "HTML Cell" count in Entire Table Dim C As Long, r As Long 'Indicies for getting appropriate Row and HTMLTableCell 'Dim n As Long ' Not needed if only one table so only "1 Loop" '4b)=== main working would be Outer loop for each Table in many similar routines==============Building Array from HTML Table 'For n = 0 To Head.Length - 1 ' We only have one table so don't need to loop. The word Length in HTML things is often similar to what Count is in many VBA objects Set oTable = Head(0) ' Somehow Head has been recognised as a table oTable as HTMLTable.JPG : https://imgur.com/R309JjC '4b(i) Fill variable for dimensions variable for each, one on our case, Main loop Dim rowCnt As Long: Let rowCnt = oTable.Rows.Length ' "length" / number of rows in this table Dim colCt As Long: Let colCt = oTable.Cells.Length 'In this object the cells "length" would appear to be the number / count of cells in the entire table Dim colCnt As Long: Let colCnt = Application.WorksheetFunction.RoundUp((colCt / oTable.Rows.Length), 0) ' 'This rounds up to the nearest avarage row width, that is to say column number in a row ' I thought this did ? colCt \ oTable.Rows.Length Dim Data() As String 'Array with string element used for output table. Fixed (static) String type for Text. ReDim Data(0 To rowCnt - 1, 0 To colCnt - 1) 'Output Array, reDimed to table being looked at. ( Hopefully always same column number, might want to hard Code to rowCnt, 11 columns . Because I am using "base" of indicie to start at 0 then I go from 0 to one less than the Count(Length) '4b(ii) Looping through rows to build output array-----------| '---Inner loop does at each row, .... For r = 0 To rowCnt - 1 'Going along the HTML Table rows exactly as pike ' https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba.html#post4026613 '--- .... 'go through each Cell( "column" ) in that row. For C = 0 To colCnt - 1 'Going along the HTML Table Cells (columns) exactly the same as pike '4b(ii)a Build Output Array Call GetElemsText(oTable.Rows(r).Cells(C), Data(r, C)) 'Data(r, c) = oTable.Rows(r).Cells(c).innerText ' pike, kyle type alternative to calling sub '4b(ii)b "post processing last column of unified units. ' Probably bad place to put this, other than Speed.. checking / changing units ' If C = ..... ' ' Else ' End If Next C '--- .... 'go to next "Cell" in that table row (next Column we "see" in the table row) Next r '--- 'Go to next row in this table----------------------------| '4b(ii)c Output from Array Let Range("A1").Resize(UBound(Data(), 1) + 1, UBound(Data(), 2) + 1).Value = Data() Columns("A:Z").AutoFit 'Next n 'go back with a new item, n in large collection Object(item) to get next object within and start checking that one out. 'Go to the next table==== Set HTMLdoc = Nothing ' If done then when we no longer need it End Sub '
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
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…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 = 40Originally Posted by Rick Rothstein
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):
That did work.JPG : https://imgur.com/01sQ91XCode: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,""))
_._______________________-
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 )
Worksheet: Rick
Row\Col 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64
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 )
Examining the first line , I can evaluate the two innermost IFs and reduce the formula toCode:' 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,""))
I will now evaluate some of those SUBSTITUTEsCode:' 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 ,"" ) )
( Excel Substitute, seems to work similarly to VBA Replace )
( I am guessing that 0+ will ensure that a number will not be mistaken as a text )Code:' IF( ISNUMBER(0+1000609815392.64), TRIM(A13" "&A14) , A13 ) ' IF( ISNUMBER(0+SUBSTITUTE(10006098,15392.64),",","")), TRIM(A13" "&A14) , A13 )
For the case of the 13th “down” formula the final steps in the evaluation go as follows
Here are all the steps together againCode:' 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 )
The final result will appear in the 13th down position of the 40 “deep” array final results for the entire formula evaluation.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,""))
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 2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5 2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64 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 2018, 1, 90515, 10024515, G9, SBlabla (HQ), CHE, BLABLA, blabla, 10012098, 12003.5 2018, 1, 90629, 10022334, P3, BLABLA blabla (blablabla), CHE, BLABLA,blabla, 10033609, 13941.72 2018, 1, 90709, 10020009, P4, Blabla og Blalala (NY), CHE, Blabla,Bla-ah, 10006098, 15392.64 2018, 1, 90765, 10012123, P4, Ch of Blabla(Blabla of Blabla), CHE, BLA-BLA,Bla Blabla, 10005678, 16231.7
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
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
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
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
Continued from last post
In a range evaluate type code line like the one we are considering, Excel VBA seems to do the following ( simplified ) ( refs *** )
Excel will have an output "window" ( this could be considered as an output table or output array ). The dimensions of this will be that rectangle that allows all used ranges in the formula to be fitted in,
There are some complicated ways in which Excel handles the situation of ranges of varying size, ( http://www.excelfox.com/forum/showth...on-and-VLookUp ) but for a simpler case of all ranges having the same size, ( in terms of "width" and "depth" ) , as we have, Excel VBA will "expand" its "output window" to this sort of thing:
Excel VBA will do its normal "along the columns, down a row, along the columns…" type thing, in any "Evaluation run". In our case this will mean that it does an evaluation at each row, going down the rows. This is what Excel VBA does in order to fill that last window of cells, ( I am just showing the first 7 of 40 similar formulas as the full list is to big to fit in a forum post )
=IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A2," ",""),",","")),IF(LEFT(A1,4)="2018",TRIM(A1&" "&A2),""),IF(LEFT(A1,4)="2018",A1,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A3," ",""),",","")),IF(LEFT(A2,4)="2018",TRIM(A2&" "&A3),""),IF(LEFT(A2,4)="2018",A2,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A4," ",""),",","")),IF(LEFT(A3,4)="2018",TRIM(A3&" "&A4),""),IF(LEFT(A3,4)="2018",A3,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A5," ",""),",","")),IF(LEFT(A4,4)="2018",TRIM(A4&" "&A5),""),IF(LEFT(A4,4)="2018",A4,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A6," ",""),",","")),IF(LEFT(A5,4)="2018",TRIM(A5&" "&A6),""),IF(LEFT(A5,4)="2018",A5,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A7," ",""),",","")),IF(LEFT(A6,4)="2018",TRIM(A6&" "&A7),""),IF(LEFT(A6,4)="2018",A6,"")) =IF(ISNUMBER(0+SUBSTITUTE(SUBSTITUTE(A8," ",""),",","")),IF(LEFT(A7,4)="2018",TRIM(A7&" "&A8),""),IF(LEFT(A7,4)="2018",A7,""))
Excel VBA will effectively make 40 formulas and place in the "output window" the result of the evaluation of those formulas
The full demo code in the next post includes a code line to put in all 40 formulas in an arbitrary 40 "deep" x 1 "wide" range ("J5:J44")
refs ***
http://www.excelfox.com/forum/showth...age3#post10201
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
test post in support of this forum question
http://www.eileenslounge.com/viewtop...245488#p245485
Yellow is effectively the array fed to a sort routine.
Green is how that array looks like after running the sort routine
_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Test calling routine : ( called routines in next 2 posts )
_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )Code:Sub TestsStringArray() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31691&p=245488#p245488 Dim arrSel() As Variant Let arrSel() = Selection.Value Dim DumDom() As String: ReDim DumDom(0 To UBound(arrSel(), 1) - 1, 0 To UBound(arrSel(), 2) - 1) Dim rCnt As Long, cCnt As Long For rCnt = 0 To UBound(arrSel(), 1) - 1 For cCnt = 0 To UBound(arrSel(), 2) - 1 Let DumDom(rCnt, cCnt) = CStr(arrSel(rCnt + 1, cCnt + 1)) Next cCnt Next rCnt Call subSort2DArrayMultiElements(DumDom(), "1 2") ' Paste reorganised Array next to the selection Dim OutRange As Range: Set OutRange = Selection.Offset(0, Selection.Columns.Count) Let OutRange.Value = DumDom() End Sub
Worksheet: Sheet1
….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
If you are my enemy, we will try to kick the fucking shit out of you…..
Winston Churchill, 1939
Save your Forum..._
KILL A MODERATOR!!
Posting Permissions
Reply With Quote
Bookmarks