Appendix Thread. 3 TEST COPY
August 2 2023
Thread 2916
First post, this one, is #post22643
This is a quick second fix to get some of the posts from the Appendix 2 made around November 2019, and stupidly deleted by me today 2 Aug 2023
From page 15 , this Thread should be left alone, please.
https://www.excelfox.com/forum/showt...ll=1#post22643
Stuff below is no longer valid but migh help give me some indication later from where it came
For more recent posts on the App Index Rws() Clms() idea, see from approximately page 50
https://www.excelfox.com/forum/showt...s-etc-)/page50
, and the best, most recent will be from about page 53
https://www.excelfox.com/forum/showt...s-etc-)/page53
Other posts before this may be subject to change and testing experiments
This thread will become the main Blog thread for posts on the App Index Rws() Clms() idea
Re: Appendix Thread. ( Codes for other Threads, HTML Tables, etc. )<o:p></o:p>
<o:p> </o:p>
Hi<o:p></o:p>
. I would like to use this Thread as an Appendix for codes in other Threads so as to help reduce clutter in that Thread should the code be a bit long, or not directly relevant.<o:p></o:p>
. Also as HTML code is on in this Test Sub Forum I would like to reference HTML Tables should I wish to use them in answering threads<o:p></o:p>
<o:p> </o:p>
@ Moderators, Administrator:<o:p></o:p>
. I hope the above is OK to do and if so please do not delete this Thread. ( Or advise if I should post my "Appendix" somewhere else ( If possible where HTML code is on ) )<o:p></o:p>
.<o:p></o:p>
. Many Thanks<o:p></o:p>
Alan<o:p></o:p>
This thread 2872
https://www.excelfox.com/forum/showt...etc)-TEST-COPY
This Post #post21226
https://www.excelfox.com/forum/showt...ll=1#post21226
(Copied from 2837)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg. 9k3ShckGnhv9k89LsaigoO
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg. 9k-vfnj3ivI9k8B2r_uRa2
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg
Grid coordinates for a Range using [ ] & Evaluate(" ") through a Named Range. Code 2
Second Code with further lines to overcome extra () required for start row and star column codes
Obtaining grid coordinates for an Area of contiguous cells in a Spreadsheet using [ ] and Evaluate(" ") through the use of a Named Range for that Area
Aka ' It is a Range Name Test 2: Its n Range Name Test 2: 's 'n Rng Name Test 2: s n Rg Name Testie 2: snRg.Name = "snRgNme"
This code is in support of other Posts in various Threads. ( I will edit the Links as I reference this post )
The code takes in a hard coded Range, A1:E10.
That Range is given a Name as held in the Names Register of a Workbook ( Workbooks Scope ).
Various code lines are developed which reference this Named Range and return the Grid Coordinates.
These coordinates are held within the following Long Type Variables
Cs is the column count
sClm is the start column
stpClm is the stop column
Rs is the rows count start row
sRw is the start row
stpRw is the stop row
Code:
' Code 2
'10 ' It is a Range Name Test 2: Its n Range Name Test 2: 's 'n Rng Name Test 2: s n Rg Name Testie 2: snRg.Name = "snRgNme"
Sub snRgNameTest2() ' Inspired by.. snb .. " array [ ] " ' http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714
20 ' Worksheets Info
30 Dim ws As Worksheet ' ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template etc.) in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
40 'Set ws = ThisWorkbook.Worksheets("NPueyoGyanArraySlicing") 'The worksheets collection object is used to Set ws to the Sheet we are playing with, so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want... ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
50 Set ws = ActiveSheet ' Alternative to last line, make code apply to the current active sheet, - That being "looked at" when running this code '
60 Dim vTemp As Variant ' To help development when you are not sure what type is retuned. "Suck and see what comnes out!" Highlight it and Hit Shift+F9 to see it in the imediate Window
70 ' Named Range referrencing ' Workbooks ( Default ) Scope Invoke Pike Evaluate Rabbit Rabbit. How's the Bunny ? Bunnytations Banters
80 Dim snRg As Range: Set snRg = ws.Range("A1:E10")
90 Dim sName As String: Let sName = "snRgNme" '
100 Let snRg.Name = "snRgNme" ' It is a Range Name me - " 's 'n Range Name me " .. "snRgNme" ;) This name appears permanentlly in then sheet. It remains referrencing this range unless the name iis deleted or the range referrenced is overwritten by a similar code line which has a different range in it on RHS of = http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
110 Let snRg.Name = sName ' Identical to last line
120
130 '== DANGER: === Pitful: Above we gave the Range Object a Name, but now see what "Name" or "Name" 's comes back "!" !
131 Dim clms() As Variant 'Array to take returned Variant type Field of sequential column numbers
132 Dim retRefstrName As String, retObjName As Object
133 Let retRefstrName = snRg.Name: Set retObjName = snRg.Name: Debug.Print snRg.Name 'something of the form "NPueyoGyanArraySlicing!$A$1:$E$10" is reveald in Immediate ( Ctrl+G when in VB Editor ) Window
134 'Let clms() = Evaluate("column(=NPueyoGyanArraySlicing!$A$1:$E$10)") 'Let clms() = Evaluate("column(" & retRefstrName & ")")' Rintime Error 13: Incompatiblee types
135 Let clms() = Evaluate("column(NPueyoGyanArraySlicing!$A$1:$E$10)") 'Works
137 Dim NameOnly As String: Let NameOnly = Replace((snRg.Name), "!", "", (InStr(1, (snRg.Name), "!"))): 'Debug.Print snRg.Name: Dim pos&: pos = InStr(1, (snRg.Name), "!"): NameOnly = Replace((snRg.Name), "!", "", pos) ' We had ---- "NPueyoGyanArraySlicing!$A$1:$E$10" This is a String referrece returned when the Name Object is used directly or set to a String Variable. so here I return a string that starts at the position of the ! and which replaces in that truncated shortened string - "!$A$1:$E$10" the "!" with nothing
138 Let clms() = Evaluate("column(" & NameOnly & ")"): Let clms() = Evaluate("column(" & Replace((snRg.Name), "!", "", (InStr(1, (snRg.Name), "!"))) & ")")
139
140 Dim strName As String: Let strName = snRg.Name.Name: Debug.Print strName: Let strName = retObjName.Name: Debug.Print strName ' returns our original "CoN"
142 Let clms() = Evaluate("column(" & strName & ")")
150 Dim rngF1G2 As Range: Set rngF1G2 = Range("F1:G2"): Let Range("F1:G2").Value = "From Line 150"
151 Let Range("=NPueyoGyanArraySlicing!F1:G2").Value = "From Line 151"
152 Let rngF1G2.Name = "snFG": Let Range("snFG").Value = "From Line 152"
153
154
159 '===============
160 Let clms() = Evaluate("column(snRgNme)"): Let clms() = [column(snRgNme)] ' Full and "shorthand" Simple 1 D "pseudo horizontal" Array of column Indicies.
170 '
180 ' Count, Start, and Stop of columns in an Area of contiguous cells in a Spreadsheet
190 Dim Cs As Long 'Variable for ColumnsCount. -This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular "Value", or ("Values" for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
200 Let Cs = Evaluate("columns(snRgNme)") ' = 5
210 'Let Cs = Evaluate("columns(RetunedsnRgName)") 'Run time Error as expected
220 Let Cs = [columns(snRgNme)] ' = 5 'Is this Most Powerful Command in VBA?, or what ... http://www.ozgrid.com/forum/showthread.php?t=52372 http://www.mrexcel.com/forum/excel-questions/899117-visual-basic-applications-range-a1-a5-vs-%5Ba1-a5%5D-benefits-dangers.html
230 'Let Cs = [columns(RetunedsnRgName)] 'Run time Error as expected
240 Let Cs = [columns(A1:E10)] ' = 5
250 Let vTemp = Evaluate("column(snRgNme)") ' Reveals an Array {1, 2, 3, 4, 5} - 1 Dimension "pseudo Horizontal" Array
260 Dim sClm As Long 'Variable for Start Column
270 Let sClm = Evaluate("column(A1:E10)")(1)
280 Let sClm = Evaluate("column(snRgNme)")(1) ' = 1
290 Let sClm = [column(A1:E10)]()(1)
300 Let sClm = [column(snRgNme)]()(1)
301
302 Let sClm = Evaluate("=MIN(column(snRgNme))"): Let sClm = [=MIN(column(snRgNme))] 'Alternative using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
329 '
330 Dim stpClm% ' Variable for Stop column Number ' ( % is shorthand for As Long ..http://www.excelforum.com/showthread.php?t=1116127&p=4256569#post4256569
340 Let stpClm = sClm + (Cs - 1) ' = 5
350 ' [ ]
360 Let stpClm = [column(A1:E10)]()(1) + ([columns(A1:E10)] - 1)
370 Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 1)
380 ' In between step [ ] and Evaluate(" ")
390 Let stpClm = [column(snRgNme)]()(UBound([column(snRgNme)]))
400 ' Now Full Evaluate(" ")
410 Let stpClm = Evaluate("column(snRgNme)")(1) + (Evaluate("columns(snRgNme)") - 1)
420 Let stpClm = Evaluate("column(snRgNme)")(UBound(Evaluate("column(snRgNme)")))
421
430 Let stpClm = Evaluate("=MIN(column(snRgNme))") + (Evaluate("columns(snRgNme)") - 1) ''Alternatives using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
431 Let stpClm = [=MIN(column(snRgNme))] + ([columns(snRgNme)] - 1)
432 Let stpClm = [=MIN(column(snRgNme)) + (columns(snRgNme) - 1)]
439 '
440 ' Start, Count and Stop of rows in an Area of contiguous cells in a Spreadsheet
450 Dim Rs As Long 'Rows Count
460 Let Rs = Evaluate("rows(snRgNme)")
470 Let Rs = [rows(snRgNme)]
480 Let Rs = [rows(A1:E10)]
490 Let vTemp = Evaluate("row(snRgNme)") ' = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
500 Dim sRw As Long 'Start Row
510 Let sRw = Evaluate("row(A1:E10)")(1, 1) 'Note a 2 Dimensional, 1 column, "vertical" Array is returned : ' vTemp = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
520 Let sRw = Evaluate("row(snRgNme)")(1, 1)
530 Let sRw = [row(A1:E10)]()(1, 1)
540 Let sRw = [row(snRgNme)]()(1, 1)
541
550 Let sRw = Evaluate("=MIN(Row(snRgNme))"): Let sRw = [=MIN(Row(snRgNme))] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
560
570 Dim stpRw% 'Stop Row
580 Let stpRw = sRw + (Rs - 1)
590 Let stpRw = [row(A1:E10)]()(1, 1) + ([rows(A1:E10)] - 1)
600 Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 1)
610 '
620 Let stpRw = [row(snRgNme)]()(UBound([row(snRgNme)], 1), 1) 'UBound([row(snRgNme)], 1) is Ubound first ( "row" ) dimension. UBound([row(snRgNme)], 2) would be the second dimension ( "column" ) count
630 '
640 Let stpRw = Evaluate("row(snRgNme)")(1, 1) + (Evaluate("rows(snRgNme)") - 1)
650 Let stpRw = Evaluate("row(snRgNme)")(UBound(Evaluate("row(snRgNme)")), 1)
660 '
670 Let stpRw = Evaluate("=MIN(Row(snRgNme))") + (Evaluate("rows(snRgNme)") - 1) ''''Alternatives using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
680 Let stpRw = [=MIN(Row(snRgNme))] + [rows(snRgNme)] - 1
690 Let stpRw = [=MIN(Row(snRgNme))] + [rows(snRgNme)] - 1
700 Let stpRw = [=MIN(Row(snRgNme)) + rows(snRgNme) - 1]
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Alternative Codes using [ ] shorthand
Alternative Codes using [ ] shorthand
Delete One Row From A 2D Excel Range Area
' To Test Function, Type some arbitrary values in range A1:E10, step through Main Test Code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
Code:
' Delete One Row From A 2D Excel Range Area
' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
' "Short hand", ShtHd, version using []
' requires snb and kalak "neat trick" so you can to all intents and purpose do very close to doing vba Un Hard coded in [ ] - http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714 http://www.mrexcel.com/forum/excel-questions/899117-visual-basic-applications-range-a1-a5-vs-%5Ba1-a5%5D-benefits-dangers.html#post4331217
' and Evaluate [ ] Properties , AloPerties, Methods - Alan Dynamic Coding Wonks http://www.excelforum.com/excel-programming-vba-macros/1141369-evaluate-and-differences-evaluated-array-return-needs-extra-bracket-for.html#post4400666
Function FuR_AlanShtHd(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
1 Let rngIn.Name = "snRgNme"
5 Dim vTemp As Variant 'A varyable to fill with something and "suck and see" what you get
10 ' use "neat magic" code line arrOut() = Application.Index(arrIn(), rwsT(), clms()) ' http://www.excelforum.com/excel-new-...ba-arrays.html http://www.mrexcel.com/forum/excel-q...ml#post4375354
20 ' BUT in Cells form arrOut() = Application.Index(Cells, rwsT(), clms()) ' http://www.excelforum.com/excel-prog...t-range-2.html
30 Dim ws As Worksheet ' ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template etc.) in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
40 Set ws = rngIn.Parent ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-prog...ml#post4387191
50 ws.Range("K30").ClearContents: ws.Range("K30").Value = "Here I am, in this Worksheet!"
60 'clms()
70 Dim sClm As Long, Cs As Long 'Variable for Count of, Start Column. - This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular "Value", or ("Values" for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
80 Let sClm = [=MIN(column(snRgNme))] '###Not needed now. Alternative using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
90 Dim clms() As Variant ' Evaluate Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
95 Let clms() = [column(snRgNme)] ' snb Range Name equivalent so ### 'Let clms() = Evaluate("column(" & CL(sClm) & ":" & CL(sClm + (Cs - 1)) & ")")
100
160 'rwsT()
170 Dim sRw As Long, Rs As Long, stpRw As Long '
180 Let sRw = [=MIN(Row(snRgNme))] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate ' Let sRw = rngIn.Areas.Item(1).Row
190 Let Rs = [rows(snRgNme)] 'Let Rs = rngIn.Areas.Item(1).Rows.Count
191 Let stpRw = [=MIN(Row(snRgNme)) + rows(snRgNme) - 1] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()( ) after the Evaluate
200
240 'Get Full row indicies convenientally ( As 1 D "pseudo horizontal" Array ) from Spreadsheet Column() Function
250 Dim rws() As Variant: Let rws() = Evaluate("column(" & CL(sRw) & ":" & CL(sRw + (Rs - 1)) & ")")
251 Let vTemp = [CL(1)]: vTemp = [CL(MIN(Row(snRgNme)))] 'Both Return "A"
252 vTemp = [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] 'Returns "J"
254 Let rws() = [column(A:J)] ' Works
257 'Let rws() = [column(CL(1):J)] ' Fails - Bug in Excel ! ? !
258 'Let rws() = [column(CL(MIN(Row(snRgNme))):CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1))] ' Fails - Bug in Excel ! ? !
260 Let rws() = Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")")
270
280 'Get full sequential row indicies in a string.
290 Dim strRws As String: Let strRws = VBA.Strings$.Join(rws(), "|") ' 'The VBA strings collection such as Join in there basic form must not returnn a string, they can also return for example Null, a special type of variant. That lies within it's "powers. - It will coerce even an Empty, or Null to a variant type and return that. That takes extra ( unecerssary work here ). If the result of a function is used as a string or assigned it to a string variable, use the $ form of the function. This results in faster executing code, because a conversion from a variant to a string is unnecessary. http://www.excelforum.com/excel-new-...ml#post4084783 I believe that without $ a Strings collection Function coerces the first parameter into Variant, with $ does not - that's why $ is preferable over no $ , it's theoretically more efficient. http://www.xoc.net/standards/rvbacc....rSignFunctions
300
330 'Get String with missing row
340 Dim strrwsD As String: Let strrwsD = Replace(strRws, "|" & FoutRw & "", "", 1, -1)
350
360 'Get Array ( 1 D Pseudo Horizontal ) of required row indicies
370 Dim rwsS() As String ' The VBA Strings Collection Function, Split, used below returns a Field of String Element Types so the Array Elemments must be Declared appropriately. It must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
375 Let rwsS() = VBA.Strings$.Split(strrwsD, "|", -1)
380 'final Transposed Array for "magic neat" code line
390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1) ' Both the type and size of Array is known so can be decared initially appropriatelly. Re Dim must be used as Dim only takes values, not variables
400 Dim Cnt As Long
410 For Cnt = 0 To UBound(rwsS())
420 Let rwsT(Cnt, 1) = rwsS(Cnt)
430 Next Cnt
440 'Output Array
450 Dim arrOut() As Variant
460 Let arrOut() = Application.Index(ws.Cells, rwsT(), clms()) '"Magic neat" Code line in Cells first argument Form
470
480 Let FuR_AlanShtHd = arrOut()
490
500 ' . Transpose
510 Dim rwsDotT() As Variant ' Transpose Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
520 Let rwsDotT() = Application.Transpose(rwsS())
530 Let arrOut() = Application.Index(ws.Cells, rwsDotT(), clms())
540
550 Let FuR_AlanShtHd = arrOut()
'
End Function
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgxesLhWNr_zNP0GUdh4AaABAg. 9hI1CQJMLLo9hWn2pGBeSS
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzkRujoMw9PblmXDQ14AaABAg. 9hJRnEjxQrd9hJoCjomNI2
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzPZbG7OvUkh35nXDd4AaABAg. 9hJOZEEZa6p9hJqLC7El-w
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgwUcEpm8u6ZW3uOHXx4AaABAg. 9hIlxxGY7t49hJsB2PWxC4
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgyvDj6NWT1Gxyy2JyR4AaABAg. 9hIKlNPeqDn9hJskm92np6
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=Ugwy7qx_kG9iUmMVO_F4AaABAg. 9hI2IGUdmTW9hJuyaQawqx
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgxesLhWNr_zNP0GUdh4AaABAg. 9hI1CQJMLLo9hJwTB9Jlob
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgyyQWYVP1OnCqavb-x4AaABAg
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgwJKKmExZ1FdZVDJf54AaABAg
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=Ugz_p0kVGrLntPtYzCt4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Array List Sort of Referrences
Referrences in suppost of this post:
http://www.excelfox.com/forum/showth...=9985#post9985
and solution to this post
http://www.excelforum.com/excel-prog...ml#post4507157
' http://www.snb-vba.eu/VBA_Arraylist_en.html
' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
' https://usefulgyaan.wordpress.com/20...1/#comment-587
' https://usefulgyaan.wordpress.com/20...1/#comment-515
Code:
' https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/comment-page-1/#comment-587
Sub M_snbSortof() ' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
Dim rngVoll As Range: Set rngVoll = Tabelle3.Range("A1:E10")
Dim snAll() As Variant, Sported() As Variant
Let snAll() = rngVoll.Value
Dim j As Long, jj As Long
With CreateObject("System.Collections.Arraylist")
For j = 1 To UBound(snAll(), 1)
.Add snAll(j, 3)
Next
.Sort
Let Sported() = .ToArray
.Clear
For j = 0 To UBound(Sported())
For jj = 1 To UBound(snAll(), 1)
If snAll(jj, 3) = Sported(j) Then
' Use Range to overcome Array size Limits of Worksheets Functions
'Dim Clm As Range: Set Clm = Application.Index(rngVoll, jj, 0)
' .Add Clm.Value
' .Add (Application.Index(rngVoll, jj, 0).Value)
' Use Cells to overcome Array size Limits of Worksheets Functions
Dim LB As Long, UB As Long '…User Given start and Stop Column as a Number
Let LB = LBound(snAll(), 2): Let UB = UBound(snAll(), 2)
Dim strLtrLB As String, strLtrUB As String '…Column Letter corresponding to Column Number
'There are many ways to get a Column Letter from a Column Number – excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html
Let strLtrLB = Split(Cells(1, LB).Address, "$")(1) 'An Address Method
Let strLtrUB = Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") 'A Replace Method
'Obtain Column Indicies using Spreadsheet Function Column via VBA Evaluate Method
Dim clms() As Variant
Let clms() = Evaluate("column(" & strLtrLB & ":" & strLtrUB & ")") 'Returns 1 D “pseudo” Horizontal Array of sequential numbers from column number of LB to UB
'Or
clms() = Evaluate("column(" & Split(Cells(1, LB).Address, "$")(1) & ":" & Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") & ")")
.Add (Application.Index(Tabelle3.Cells, jj, clms()))
'Let snAll(jj, 3) = ""
Exit For
End If
Next jj
Next j
For j = 0 To .Count - 1
Tabelle3.Cells(j + 1 + 10, 1).Resize(, UBound(snAll, 2)) = .Item(j)
Next j
End With
End Sub
'
Sub M_snb()
Dim sn, sp, j As Long, jj As Long
sn = Tabelle3.Range("A1:E10")
With CreateObject("System.Collections.Arraylist")
For j = 1 To UBound(sn)
.Add sn(j, 3)
Next
.Sort
sp = .ToArray
.Clear
For j = 0 To UBound(sp)
For jj = 1 To UBound(sn)
If sn(jj, 3) = sp(j) Then
.Add Application.Index(sn, jj)
sn(jj, 3) = ""
Exit For
End If
Next
Next
For j = 0 To .Count - 1
Tabelle3.Cells((j + 1) + 10, 1).Resize(, UBound(sn, 2)) = .Item(j)
Next
End With
End Sub
'Rem Ref
' http://www.excelforum.com/excel-programming-vba-macros/1139207-how-to-move-a-userform-and-module-from-one-book-to-another-2.html
' http://www.excelforum.com/excel-programming-vba-macros/1138300-vba-userform-value-check-if-user-form-buttons-checked-not-working-check-button-on-open.html
' http://www.excelforum.com/excel-programming-vba-macros/1139742-workbooks_open-crashes-when-file-opened-with-code-manually-open-ok-userform-issue.html
' http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985
' http://www.snb-vba.eu/VBA_Arraylist_en.html
' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
' http://www.excelforum.com/showthread.php?t=1154829&page=4#post4502593
' http://www.excelforum.com/excel-programming-vba-macros/1160648-how-to-create-a-pop-up-notification-for-two-different-conditions-at-the-same-time.html#post4507157
' http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985
http://www.excelforum.com/showthread...=4#post4502593
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgxesLhWNr_zNP0GUdh4AaABAg. 9hI1CQJMLLo9hWn2pGBeSS
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzkRujoMw9PblmXDQ14AaABAg. 9hJRnEjxQrd9hJoCjomNI2
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzPZbG7OvUkh35nXDd4AaABAg. 9hJOZEEZa6p9hJqLC7El-w
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgwUcEpm8u6ZW3uOHXx4AaABAg. 9hIlxxGY7t49hJsB2PWxC4
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgyvDj6NWT1Gxyy2JyR4AaABAg. 9hIKlNPeqDn9hJskm92np6
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=Ugwy7qx_kG9iUmMVO_F4AaABAg. 9hI2IGUdmTW9hJuyaQawqx
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgxesLhWNr_zNP0GUdh4AaABAg. 9hI1CQJMLLo9hJwTB9Jlob
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgyyQWYVP1OnCqavb-x4AaABAg
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgwJKKmExZ1FdZVDJf54AaABAg
https://www.youtube.com/watch?v=pkhazgI3LAo&lc=Ugz_p0kVGrLntPtYzCt4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Second Code for Nelson using Admin Formula Idea
Second Code for nelson
Post 9
http://www.excelfox.com/forum/showth...0070#post10070
Code:
Sub IJAdjustKAddTotalAllWorksheet() ' http://www.excelfox.com/forum/showthread.php/2144-Code-Required-to-calculate-number-of-days-worked-normal-overtime-and-holiday-overtime?p=10060#post10060
Rem 1) Workbooks Info.
Dim Wb As Workbook ' Dim: For Object variabls: Address location to a "pointer". That has all the actual memory locations (addresses) of the various property values , and it holds all the instructions what / how to change them , should that be wanted later. That helped explain what occurs when passing an Object to a Call ed Fucntion or Sub Routine By Val ue. In such an occurance, VBA actually passes a copy of the pointer. So that has the effect of when you change things like properties on the local variable , then the changes are reflected in changes in the original object. (The copy pointer instructs how to change those values, at the actual address held in that pointer). That would normally be the sort of thing you would expect from passing by Ref erence. But as that copy pointer "dies" after the called routine ends, then any changes to the Addresses of the Object Properties in the local variable will not be reflected in the original pointer. So you cannot actually change the pointer.)
Set Wb = ActiveWorkbook ' Set: Fill or partially Fill: Setting to a Class will involve the use of an extra New at this code line. I will then have an Object referred to as an instance of a Class. At this point I include information on my Pointer Pigeon hole for a distinct distinguishable usage of an Object of the Class. For the case of something such as a Workbook this instancing has already been done, and in addition some values are filled in specific memory locations which are also held as part of the information in the Pigeon Hole Pointer. We will have a different Pointer for each instance. In most excel versions we already have a few instances of Worksheets. Such instances Objects can be further used., - For this a Dim to the class will be necessary, but the New must be omitted at Set. I can assign as many variables that I wish to the same existing instance
Dim wsStear As Worksheet ' Used for each Worksheet counting Tabs from left from 1 To Total
Rem 2) varables for some totals ;)
Const TDays As Long = 30 'Total days just taken as 30 ' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
Dim Dte As Date, DteNo As Long ' I am hoping Dte will sort out getting a date in a format that I can use the Weekday function to see what week day it is and get that as a nuumber to check for..
Rem 3) Loop through worksheets and give some Totals
Dim Cnt As Long ' Loop Bound variable count for going through all worksheets
'3a) main Loop start=====================================================
For Cnt = 1 To Wb.Worksheets.Count ' The Worksheets collection Object Property returns the number of worksheet items in the Workbook
Set wsStear = Wb.Worksheets.Item(Cnt) ' At each loop the variable is set to the current Worksheet counting from the Cnt'ths tab from left
Dim lr As Long ' Used for last row number in column E
Let lr = wsStear.Range("E" & Rows.Count & "").End(xlUp).Row ' The Range Object ( cell ) that is the last cell in the column of interest (CHOOSE a column typically that will always have a last Entry in any Data) ,( Row Number given by .Count Property applied to ( any Worksheet would do, so leaving unqualified is OK here, ) Spreadsheet Range Rows Property) has the Property .End ( argument "Looking back up" ) appled to it. This Returns a new Range ( cell ) object which is that of the first Range ( cell ) with something in it "looking back up" in the XL spreadsheet from that last Cell. Then the .Row Property is applied to return a long number equal to the Row number of that cell: Rows.Count is the very last row number in your Worksheet. It is different for earlier versions of Excel. The End(xlUp) is the same as pressing a Ctrl+UpArrow key combination. The final ".Row" returns the row where the cursor stops after moving up.
Dim FstDtaCel As Range: Set FstDtaCel = wsStear.Range("A1") ' Worksheets Range(" ") Property used to return Range object of first cell in second row
'3b) Data arrays from worksheet. We need columns E H I J .... Date ( Column E ) and Total hrs ( Column H ) are required to use in calculations
Dim arrInNorm() As Variant, arrInOver() As Variant ' In the next lines the .Value2 or .value Property is applied a Range object which presents the Value or Value2 value or values in a single variable of appropriate type or a field of member Elements of varaint types.We are expecting the latter, so declare ( Dim ) a dynamic Array variable appropriately. It must be dynamic as its size will be defined at that assignment
Let arrInNorm() = FstDtaCel.Offset(0, 8).Resize(lr, 1).Value2 ' I ' Normal Hrs ( Column I ) are needed as they must be set to zero for Holy ?? Holidays ?? Friday ??
Let arrInOver() = FstDtaCel.Offset(0, 9).Resize(lr, 1).Value2 ' J ' Overtime ( Column J ) is needed as it will be changed and then used in calculations
Dim arrTotHrs() As Variant ' ,' ## ' arrDteClr() As Variant
Let arrTotHrs() = FstDtaCel.Offset(0, 7).Resize(lr, 1).Value ' H ' ' One thing you pick up when learning VBA programming is that referring to cells from one to another via an offset is both fundamental and efficient. That makes sense as Excel is all about using the offsets mentioned above. So like if you use them you can “cut out the middle man”. ( The middle man here might be considered as, for example, in VBA, using extra variables for different Range objects: A fundamental thing to do with any cell ( or strictly speaking the Range object associated to a cell ) is the Range Item Property of any range Object, through which you can “get at” any other Range object. http://www.excelforum.com/showthread.php?t=1154829&page=13&p=4563838&highlight=#post4563838 ( It is often quicker than using a separate variable for each Range object – probably as all the variable does is hold the offset , so you might as well use the offset in the first place.. )
' Similarly Another thing you pick up along the way is that the cells ( or strictly speaking the Range objects associated with it ) can be organised into groups of cells which then are also called Range objects and are organised in their constituent parts exactly the same as for the single cell Range object. Once again this is all an indication of organising so that we get at information by sliding along a specific amount ( offset value). The Offset and Resize properties therefore return a new range object. I use the .Value 2 here as i seemed to get it for .Value anyway, not sure why yet, - so i thought be on the safe side , get it always and work somehow with that for now and convert as necerssary. Also 1 breadth Arrays due to Alan Intercept theory are held in such a ways as to be very effient in usage of values within
Dim arrK() As String 'I know the size, but must make it dynamic as Dim declaration only takes numbers, and so I use ReDim method below wehich can also take variables or formulas
ReDim arrK(1 To UBound(arrInNorm(), 1), 1 To 1) ' Any array first dimension ("row") will do
'This will not work. ' ## ' Let arrDteClr() = FstDtaCel.Offset(0, 4).Resize(lr, 1).Interior.Color ' because .Interior property for a Range object shows only one value for the entire range which seems to be zero unless all the cells have a colour
Dim arrDteClr() As Double, rngDts As Range
Set rngDts = FstDtaCel.Offset(0, 4).Resize(lr, 1)
Dim Rws As Long: ReDim arrDteClr(1 To lr, 1 To 1) ' so must loop in each Interior color value
For Rws = 1 To UBound(arrDteClr(), 1) Step 1 'InnerLoop for dates background colors
Let arrDteClr(Rws, 1) = rngDts.Item(Rws, "A").Interior.Color
Next Rws
'3c) Inner loop for rows
Dim ShtCnt As Long ' Loop Bound Variable Count for hours columns looping
For ShtCnt = 1 To UBound(arrDteClr(), 1) Step 1 '------------------- For "rows" in data arrays
'3d) We need to check Interior color Adjust columns I and J so that column I has no hours for holiday day and total hours goes to over time hours with criteria 9 or less than 9 hrs all total hours added overtime, 10 or above 10 hrs one hour deducted from total hours and added to column J ..... and add a H or N in helper column K
If arrDteClr(ShtCnt, 1) = 65535 Then
If (arrTotHrs(ShtCnt, 1) * 24) <= 9 Then '(i) If Total Hrs are less than or equal to 9 ,Then all Total Hrs are added to Overtime Hrs
Let arrInOver(ShtCnt, 1) = arrTotHrs(ShtCnt, 1) ' Given To ' Added to arrInOver(ShtCnt, 1) + arrTotHrs(ShtCnt, 1)
ElseIf (arrTotHrs(ShtCnt, 1) * 24) > 9 Then ' (ii) If Total Hrs are less greater than 9 , Then ( Total Hrs - 1 ) are added to Overtime Hrs
Let arrInOver(ShtCnt, 1) = arrTotHrs(ShtCnt, 1) - 1 / 24 ' Given To ' arrInOver(ShtCnt, 1) + arrTotHrs(ShtCnt, 1) - 1 / 24 'Added to 1 hr less overtime for more than 9 hrs worked
End If
Let arrInNorm(ShtCnt, 1) = Empty ' (iii) As array is variant type can empty Remove normal Hrs Array for(Column I) is then set tom zerow for this "row"o
Let arrK(ShtCnt, 1) = "H" ' Give string, "" value of H for Holiday in Admin's help column K
Else ' No Holy Holiday
Let arrK(ShtCnt, 1) = "N" ' give string N for normal
End If
'3e) ' from last code, is not now used to calculate totals
Next ShtCnt '--------------------------End Inner loop for rows-----
'3f) Paste out final Totals and days to current Worksheet
Let wsStear.Range("G35").Value = "=SUMIF(K1:K" & lr & ",""N"",J1:J" & lr & ")*24"
Let wsStear.Range("J35").Value = "=SUMIF(K1:K" & lr & ",""H"",J1:J" & lr & ")*24"
Let wsStear.Range("C34").Value = TDays ' The constant value of Total days is simply added to cell C34
'3g) Normal Hrs ( Column I ) and Overtime Hrs ( Column J ) are changed ' And can paste out help column if you like
Let FstDtaCel.Offset(0, 9).Resize(lr, 1).Value2 = arrInOver() ' J ' The required spreadsheet cells range has its Range Object .Value2 values filled an allowed direct assignment to an array of values
Let FstDtaCel.Offset(0, 8).Resize(lr, 1).Value2 = arrInNorm() ' I
Let FstDtaCel.Offset(0, 10).Resize(lr, 1).Value2 = arrK() ' K
Next Cnt '==End main Loop==============================================
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Results for RaghavendraPrabhu
Table of final results for solution to this Thread:
http://www.excelfox.com/forum/showth...0548#post10548
Using Excel 2007 32 bit
S No |
Item |
Price |
Qty |
Total |
Date Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Date Tasks Completed |
Date Consolidated |
Comments |
Team Member |
1 |
A1 |
$ 25.00 |
7 |
$ 175.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
22.Mrz 18 |
|
Raghu |
2 |
A5 |
$ 95.00 |
52 |
$ 4,940.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
22.Mrz 18 |
|
Raghu |
3 |
B1 |
$ 985.00 |
65 |
$ 64,025.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
4 |
B5 |
$ 85.00 |
7 |
$ 595.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
22.Mrz 18 |
|
Raghu |
5 |
C1 |
$ 41.00 |
52 |
$ 2,132.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
22.Mrz 18 |
|
Raghu |
6 |
C5 |
$ 655.00 |
65 |
$ 42,575.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
22.Mrz 18 |
|
Raghu |
7 |
D1 |
$ 1,258.00 |
7 |
$ 8,806.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
22.Mrz 18 |
|
Raghu |
8 |
D5 |
$ 44.00 |
52 |
$ 2,288.00 |
22. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
9 |
D10 |
$ 55.00 |
22 |
$ 1,210.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
22.Mrz 18 |
22.Mrz 18 |
|
Raghu |
10 |
A3 |
$ 22.00 |
9 |
$ 198.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
|
|
Raju |
11 |
A7 |
$ 11.00 |
12 |
$ 132.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Raju |
12 |
B3 |
$ 223.00 |
85 |
$ 18,955.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
|
|
Raju |
13 |
B7 |
$ 63.00 |
9 |
$ 567.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
|
|
Raju |
14 |
C3 |
$ 96.00 |
12 |
$ 1,152.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
|
|
Raju |
15 |
C7 |
$ 11.00 |
85 |
$ 935.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
|
|
Raju |
16 |
D3 |
$ 332.00 |
9 |
$ 2,988.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
|
|
Raju |
17 |
D7 |
$ 566.00 |
12 |
$ 6,792.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
|
|
Raju |
18 |
A4 |
$ 45.00 |
41 |
$ 1,845.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Ramesh |
19 |
A8 |
$ 36.00 |
32 |
$ 1,152.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
|
|
Ramesh |
20 |
B4 |
$ 41.00 |
96 |
$ 3,936.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
|
|
Ramesh |
21 |
B8 |
$ 52.00 |
41 |
$ 2,132.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
|
|
Ramesh |
22 |
C4 |
$ 85.00 |
32 |
$ 2,720.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
|
|
Ramesh |
23 |
C8 |
$ 458.00 |
96 |
$ 43,968.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
|
|
Ramesh |
24 |
D4 |
$ 22.00 |
41 |
$ 902.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
|
|
Ramesh |
25 |
D8 |
$ 332.00 |
32 |
$ 10,624.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
|
|
Ramesh |
26 |
A2 |
$ 35.00 |
8 |
$ 280.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
|
|
Ravi |
27 |
A6 |
$ 78.00 |
63 |
$ 4,914.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
|
|
Ravi |
28 |
B2 |
$ 11.00 |
47 |
$ 517.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
|
|
Ravi |
29 |
B6 |
$ 96.00 |
8 |
$ 768.00 |
18. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
30 |
C2 |
$ 74.00 |
63 |
$ 4,662.00 |
18. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
31 |
C6 |
$ 365.00 |
47 |
$ 17,155.00 |
20. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
32 |
D2 |
$ 33.00 |
8 |
$ 264.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
|
|
Ravi |
33 |
D6 |
$ 55.00 |
63 |
$ 3,465.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
|
|
Ravi |
34 |
A9 |
$ 12.00 |
65 |
$ 780.00 |
22. Mrz 18 |
|
|
|
|
|
|
|
Sangeeta |
35 |
B9 |
$ 45.00 |
47 |
$ 2,115.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
21.Mrz 18 |
|
|
Sangeeta |
36 |
C9 |
$ 56.00 |
85 |
$ 4,760.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
21.Mrz 18 |
|
|
Sangeeta |
37 |
D9 |
$ 89.00 |
96 |
$ 8,544.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
21.Mrz 18 |
|
|
Sangeeta |
38 |
A10 |
$ 25.00 |
3 |
$ 75.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
21.Mrz 18 |
|
|
Sangeeta |
https://www.youtube.com/watch?v=vXyMScSbhk4
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgynOSp1dleo-Z8L_QN4AaABAg.9jJLDC1Z6L-9k68CuL4aTY
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwV5N_ulFXYMNbyQG54AaABAg. 9itCkoVN4w79itOVYVvEwQ
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgyOh-eR43LvlIJLG5p4AaABAg.9isnKJoRfbL9itPC-4uckb
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugy1B1aQnHq2WbbucmR4AaABAg. 9isY3Ezhx4j9itQLuif26T
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgxxajSt03TX1wxh3IJ4AaABAg. 9irSL7x4Moh9itTRqL7dQh
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwJAAPbp8dhkW2X1Uh4AaABAg. 9iraombnLDb9itV80HDpXc
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgzIzQ6MQ5kTpuLbIuB4AaABAg. 9is0FSoF2Wi9itWKEvGSSq
Final Results for Code 2b) for Raghavendra
Final Results for this Thread Post
http://www.excelfox.com/forum/showth...0575#post10575
S No |
Item |
Price |
Qty |
Total |
Date Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Date Tasks Completed |
Date Consolidated |
Comments |
Team Member |
1 |
A1 |
$ 25.00 |
7 |
$ 175.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Raghu |
2 |
A5 |
$ 95.00 |
52 |
$ 4,940.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Raghu |
3 |
B1 |
$ 985.00 |
65 |
$ 64,025.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
4 |
B5 |
$ 85.00 |
7 |
$ 595.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
24.Mrz 18 |
|
Raghu |
5 |
C1 |
$ 41.00 |
52 |
$ 2,132.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
24.Mrz 18 |
|
Raghu |
6 |
C5 |
$ 655.00 |
65 |
$ 42,575.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
24.Mrz 18 |
|
Raghu |
7 |
D1 |
$ 1,258.00 |
7 |
$ 8,806.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
24.Mrz 18 |
|
Raghu |
8 |
D5 |
$ 44.00 |
52 |
$ 2,288.00 |
22. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
9 |
D10 |
$ 55.00 |
22 |
$ 1,210.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
22.Mrz 18 |
24.Mrz 18 |
|
Raghu |
10 |
A3 |
$ 22.00 |
9 |
$ 198.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Raju |
11 |
A7 |
$ 11.00 |
12 |
$ 132.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Raju |
12 |
B3 |
$ 223.00 |
85 |
$ 18,955.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
24.Mrz 18 |
|
Raju |
13 |
B7 |
$ 63.00 |
9 |
$ 567.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
24.Mrz 18 |
|
Raju |
14 |
C3 |
$ 96.00 |
12 |
$ 1,152.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
24.Mrz 18 |
|
Raju |
15 |
C7 |
$ 11.00 |
85 |
$ 935.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
24.Mrz 18 |
|
Raju |
16 |
D3 |
$ 332.00 |
9 |
$ 2,988.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
24.Mrz 18 |
|
Raju |
17 |
D7 |
$ 566.00 |
12 |
$ 6,792.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
24.Mrz 18 |
|
Raju |
18 |
A4 |
$ 45.00 |
41 |
$ 1,845.00 |
17. Mrz 18 |
|
|
|
|
|
|
|
Ramesh |
19 |
A8 |
$ 36.00 |
32 |
$ 1,152.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
20 |
B4 |
$ 41.00 |
96 |
$ 3,936.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
21 |
B8 |
$ 52.00 |
41 |
$ 2,132.00 |
18. Mrz 18 |
Done |
N/A |
Done |
N/A |
18.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
22 |
C4 |
$ 85.00 |
32 |
$ 2,720.00 |
18. Mrz 18 |
N/A |
Done |
N/A |
Done |
18.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
23 |
C8 |
$ 458.00 |
96 |
$ 43,968.00 |
20. Mrz 18 |
Done |
N/A |
Done |
N/A |
20.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
24 |
D4 |
$ 22.00 |
41 |
$ 902.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
25 |
D8 |
$ 332.00 |
32 |
$ 10,624.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
24.Mrz 18 |
|
Ramesh |
26 |
A2 |
$ 35.00 |
8 |
$ 280.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Ravi |
27 |
A6 |
$ 78.00 |
63 |
$ 4,914.00 |
17. Mrz 18 |
Done |
N/A |
Done |
N/A |
17.Mrz 18 |
24.Mrz 18 |
|
Ravi |
28 |
B2 |
$ 11.00 |
47 |
$ 517.00 |
17. Mrz 18 |
N/A |
Done |
N/A |
Done |
17.Mrz 18 |
24.Mrz 18 |
|
Ravi |
29 |
B6 |
$ 96.00 |
8 |
$ 768.00 |
18. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
30 |
C2 |
$ 74.00 |
63 |
$ 4,662.00 |
18. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
31 |
C6 |
$ 365.00 |
47 |
$ 17,155.00 |
20. Mrz 18 |
|
|
|
|
|
|
|
Ravi |
32 |
D2 |
$ 33.00 |
8 |
$ 264.00 |
20. Mrz 18 |
N/A |
Done |
N/A |
Done |
20.Mrz 18 |
24.Mrz 18 |
|
Ravi |
33 |
D6 |
$ 55.00 |
63 |
$ 3,465.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
22.Mrz 18 |
24.Mrz 18 |
|
Ravi |
34 |
A9 |
$ 12.00 |
65 |
$ 780.00 |
22. Mrz 18 |
|
|
|
|
|
|
|
Sangeeta |
35 |
B9 |
$ 45.00 |
47 |
$ 2,115.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
21.Mrz 18 |
24.Mrz 18 |
|
Sangeeta |
36 |
C9 |
$ 56.00 |
85 |
$ 4,760.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
21.Mrz 18 |
24.Mrz 18 |
|
Sangeeta |
37 |
D9 |
$ 89.00 |
96 |
$ 8,544.00 |
22. Mrz 18 |
Done |
N/A |
Done |
N/A |
21.Mrz 18 |
24.Mrz 18 |
|
Sangeeta |
38 |
A10 |
$ 25.00 |
3 |
$ 75.00 |
22. Mrz 18 |
N/A |
Done |
N/A |
Done |
21.Mrz 18 |
24.Mrz 18 |
|
Sangeeta |
5 Attachment(s)
Search for text in txt File using VBA, display rows where text found
Code in support of these Threads:
http://www.excelfox.com/forum/showth...0582#post10582
What code does in General:
This code will search for specific text in a text file
What code does in Specifically:
The code assumes that you have a simple text file looking something like this:
TextRowsInTextFile.jpg : https://imgur.com/upBY709
Attachment 2031
HotFixID
{EF8CD7FC-438D-49E3-A2C7-201052D9F2EF}
{8D2CDFAB-0079-43CC-A289-2F7A67F0A4DE}
{98D8F490-1F42-4F29-A59B-BF96D23A11BA}
{B730F010-3FCF-4E80-8A5A-C1DBEC0CF55A}
{B73E5AF4-40C6-4EA9-8F57-CFA70CC72BD6}
{BF11577A-6876-45AA-86C9-2BA4CFB8B019}
{E359D786-B101-4545-B8AB-8652323CF3CA}
{F4139440-5426-4C6F-909B-F71CEB1071B1}
{B2FAD7E1-67F9-435D-98BD-A77DBF4E1381}
Here is the example text file used in this explanation and currently hard coded into the code : “UpdatesOnVistaAspire4810TZG25thMarch.txt” : https://app.box.com/s/z90o8yj7iz0188yci34mu7gahe2tfhce
You can input , when prompted, a text string or text strings to look for. For more than one text string you should separate them by at least one space, like
__ B23 ___6872 35689
( The code below has those actual strings hard coded as the default search values )
Input Box Functioning.jpg : https://imgur.com/o9wlnhK https://imgur.com/JtnTDmy
Attachment 2030 Attachment 2034
The code will look for those text strings in all text file lines except the first.
( there is also a section to check the content of the first line, but it is 'commented out in the code below )
The code searches for those lines which contain any of those strings. In this demo example, one thing that I would be looking for is the rows in the text file containing B23 in them, so that would be the middle few in this screenshot .. B23 TextRowsInTextFile.JPG : https://imgur.com/JHRqJJc
Attachment 2032
The final result of the codes is to give you a string message which has a list of the text strings that you were looking for, and a list of the full text in any rows which contained that. The string is displayed in a message box. In addition if you are in the VB Editor Window and hit Ctrl+g , the you will see the results also in the immediate window. This latter has the advantage that you can copy the data to the clipboard by highlighting it and hitting Ctrl+c , ( or alternatively select the text and select the option to copy available via right mouse click ) : YouLookedForFindedWas.JPG: https://imgur.com/tyW4HSJ
Attachment 2033
Here is the code. It should be pasted into any File which is in the same Folder as the text file you want to search through. Currently the code is hard coded to search the file with name
“UpdatesOnVistaAspire4810TZG25thMarch.txt”
So you will need to change that to suit your text file name.
Code:
Sub CheqUpDates()
On Error GoTo GetLaid ' Instruction to replace / modify VBA default error handler by hanging on to the arousal this code starting from the labelled label code area
Rem 1) ActiviaExcretionLink, AEL. Checking Object link mechanismus
'1a) Exposing of interfaces for active RunableTimed data axctivated link
Dim ActiviEL As String ' "Pointer" to a "Blue Print" (or Form, Questionnaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructions will tell how to do this. Theoretically a special value vbNullString is set to aid in quick checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
Let ActiviEL = ThisWorkbook.Path & "\UpdatesOnVistaAspire4810TZG25thMarch.txt" 'Will be referrenced in code through an opened "route" to it
Dim LedgerFreiNummer As String: Let LedgerFreiNummer = "1" & "00" ' Not required in this code : https://www.excelforum.com/excel-general/1225401-value-of-true-1-or-1-vba-vs-worksheet.html
Dim AEL_Highway As Long: Let AEL_Highway = FreeFile("" & LedgerFreiNummer & "") ' Obtain from 2nd building phase (256-511) Ledger of available Highways, coercidentally to value 1_255 likely , bits of my 1 & 00
Rem 2) text file info
' '2a) Open File read first line check the sht - want Head
' Open ActiviEL For Input As AEL_Highway '
' Dim ShtHead As String
' Line Input #AEL_Highway, ShtHead ' Check substancialating for getting good Head
' If InStr(1, ShtHead, "HotFix", vbTextCompare) = 0 Then
' MsgBox prompt:="Got no HotFix IDin " & ShtHead
' Exit Sub
' Else
' Debug.Print ShtHead
' End If
' Close AEL_Highway ' Datei scheißen
'2b) "row" count in text file
Dim RecardRows As Long ' '_-' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
Let RecardRows = 0
Dim strLine As String
Open ActiviEL For Input As AEL_Highway ' Activated embedded Link objectimocom Binary as to referencingmocomed aka AliAs AEL_Highway opened of now
Do Until EOF(AEL_Highway) 'Looping all lines in text file ' Solange bis Datei-Ende - EOF(AEL_Highway) will be set to true by the last a carriage liney mo not found a next line in Line Input #AEL_Highway, strLine
Line Input #AEL_Highway, strLine: Let RecardRows = RecardRows + 1 ' Inputed der liney mo a carriage returned after then record register count of it to that increase by the one done liney mo
Loop 'Do Until EOF(AEL_Highway) 'Looping all lines in text file
'Let RecardRows = RecardRows + 1 'would need to do this if I did not closeat '2a) and reopen in '2b)
Close AEL_Highway ' Datei scheißen - scheise drauf der Highway geschnmut - no longer activamoed AEL not activia mated mo
Rem 3) Prepare output Array for all text File data
Dim arrOut() As String: ReDim arrOut(1 To RecardRows) ' can declare to known size and type. We cannot use Dim arrOut(1 to RecardRows) as pre complie compile cannot do the RecardRows is not available: method ReDim is Runtime
Rem 4) Main loop for filling in Output Data =============================================
Open ActiviEL For Input As AEL_Highway
Dim RecardRow As Long ', strLine As String
For RecardRow = 1 To RecardRows '(Do Until EOF(AEL_Highway) 'Looping all lines in text file)
Line Input #AEL_Highway, strLine: Let arrOut(RecardRow) = strLine ' Zeile lesen - as before but this time place in element of output array
Next RecardRow ' ===== (Do Until EOF(AEL_Highway) 'Looping all lines in text file)===
Close AEL_Highway ' Datei schließen
Rem 5) search for specific strings
'5a) Bring in text or texts to be searched for, reduce multiple spaces to single spaces between if more than one given and, and split into array of those individual text strings https://powerspreadsheets.com/excel-vba-inputbox/ http://www.excelfox.com/forum/showthread.php/2227-VBA-Input-Pop-up-Boxes-Application-InputBox-Method-versus-VBA-InputBox-Function?p=10462#post10462
Dim strSrch As String '
Let strSrch = VBA.InputBox(prompt:="Type in all or part of text or texts to be searched for" & vbCrLf & "Seperate texts by at least one space", Title:="Input text to be searched for in text File lines", Default:="KB23 6872 35689", xpos:=100, ypos:=100)
Let strSrch = Evaluate("=TRIM(SUBSTITUTE(" & """" & strSrch & """" & ",CHAR(32)," & """" & " " & """" & "))") ' TRIM function trims the 7-bit ASCII space character (value 32). In the Unicode character set, there is an additional space character called the nonbreaking space character that has a decimal value of 160. This character is commonly used in Web pages as the HTML entity, . By itself, the TRIM function does not remove this nonbreaking space character. https://www.excelforum.com/excel-formulas-and-functions/1217202-is-there-a-function-similar-to-trim-but-that-only-removes-trailing-spaces-2.html
Dim SrchTxts() As String ' VBA strings function split to be used to get individual text into elements of an Array. The split function returns an array of string type elements
Let SrchTxts() = VBA.Split(strSrch, " ", -1, vbTextCompare) ' Split the ( strSrch , using space as delimiter , for unrestricted count , using text compare which is case insensitive )
For RecardRow = 2 To RecardRows 'At each record row
Dim Txtie As Long ' in default example this is 0 1 2
For Txtie = 0 To UBound(SrchTxts()) ' VBA Split retuns a 1 dimension array starting at indicie 0 For example we have indicies of 0 1 2 givig three elements in total of KB23 6872 35689
Dim strFnded As String
If InStr(1, arrOut(RecardRow), SrchTxts(Txtie), vbTextCompare) > 0 Then Let strFnded = strFnded & vbCrLf & arrOut(RecardRow) ' The returned postion along from the left ( starting from fist character , in the current row , looking for current text string , compare text which is case insensitive ) This will return 0 if not found and if found the postione along from the left in the row string where the search string part starts. So an found position will do for a find
Next Txtie
Next RecardRow
Rem 6) Display search results
Let strSrch = Replace(strSrch, " ", vbCrLf, 1, -1, vbBinaryCompare) 'replace in ( strSrch , space , with carriage return , start at and return from first character , no resriction on count , compare of exact computer memory so effectively case sensitive which is probably faster ) for convinent string list in output later
MsgBox prompt:="You looked for" & vbCrLf & strSrch & vbCrLf & vbCrLf & "Finded was" & strFnded
Debug.Print "You looked for" & vbCrLf & strSrch & vbCrLf & vbCrLf & "Finded was" & strFnded
Exit Sub ' Normal code ending
GetLaid: ' "Error handling code section http://www.excelfox.com/forum/showthread.php/2239-Resume-On-Error-GoTo-0-1-GoTo-Error-Handling-Statements-Runtime-VBA-Error-Handling-ORNeRe-GoRoT-N0Nula-1
MsgBox (Err.Description)
Close AEL_Highway ' Datei scheißen
End Sub
Some typical results in next post
5 Attachment(s)
Finding and deleteing .exd files
Appendix notes in support of these Threads:
http://www.excelfox.com/forum/showth...en-insert-them
http://www.excelfox.com/forum/showth...ommand-Buttons
Trying to find .exd files and delete them.
The results of most of what I have read or results of asking people suggests that they are usually findable if you look for a temp or temp somewhere in a file path
These appear a bit difficult to find sometimes . You can try:
_ manually navigating
_ a windows explorer search for *.exd
StarDotexeExplorerSearch.JPG : https://imgur.com/hfbC93Z
Attachment 2037
_ a search in a small bar using %temp% or %Temp%
You can get the small bar from either hitting WindowsKey+r or by selecting the Windows symbol
PerCenttempPerCentsearch.JPG : https://imgur.com/LypHLGY
Attachment 2038
PerCenttempPerCentsearch2.jpg : https://imgur.com/DZvycco
Attachment 2039
It seems a bit inconsistent which search finds what, but usually it is said that you find important places looking something like these:
C:\Users\username\AppData\Local\Temp\Excel8.0
C:\Users\username\AppData\Local\Temp\VBE
I found sometimes .exd files here also
C:\Users\username\Application Data\Microsoft\Forms
Some other typical places I found
C:\Dokumente und Einstellungen\Administrator\Application Data\Microsoft\Forms
C:\Dokumente und Einstellungen\Administrator\AppData\LocalLow
_.____._____________________
This is one of my typical attempts to get a ActiveX control button to_... either
_ insert into worksheet
or , if already three
_ work
_... by deleting .exd files
What I typically tried:
I looked here C:\Users\Elston\AppData\Local\Temp\Excel8.0
I found this:
C Users Elston AppData Local Temp Excel8.0.jpg https://imgur.com/doXstmr
Attachment 2040
I deleted that MSForms.exd File ( Excel had to be closed to do that ) : It had no effect. ( By the way, MSForms.exd gets made again every time I hit the button, or it appears to get made as soon as I open any file that either has or has ever had a control embedded in a worksheet)
In C:\Users\Elston\AppData\Local\Temp\VBE I found these:
C Users Elston AppData Local Temp VBE.jpg https://imgur.com/wjaZpXp
Attachment 2041
So…for these files I did:…
MSComctlLib.exd : I deleted this , - no effect
MSForms.exd : This could not be deleted with Excel 2003 open, it can when it is closed. But that had no effect
RefEdit.exd : This could not be deleted with Excel 2003 open, it can when it is closed. But no that had effect
( By the way, MSForms.exd and RefEdit.exd get made again every time I hit the button, or it appears to get made as soon as I open any file that either has, or has ever had, a control embedded in a worksheet )
In C:\Users\Elston\Application Data\Microsoft\Forms
I found these:
( https://imgur.com/Lv2kyhk )
So……for these files I did:…
RefEdit.exd This could not be deleted with Excel 2003 open, it can when it is closed. But that had no effect
mscomctllib.exd I deleted this: That had no effect
SHDocVw.exd I deleted this: That had no effect
( By the way, MSForms.exd gets made again every time I hit the button, or it appears to get made as soon as I open any file that either has or has ever had a control embedded in a worksheet)
_.._______________-
So for me none of that helped to get me a working ActiveX control Button in a worksheet.
:(
Typical Updated Data File, "Raghu.xlsx" after first consolidation
Typical Updated Data File, "Raghu.xlsx" after first consolidation,
with the column L updated appropriately with the consolidation date
Using Excel 2007 32 bit
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
O |
|---|
1 |
S No |
Item |
Price |
Qty |
Total |
Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Completed |
Consolidated |
Comments |
Team Member |
|
2 |
1 |
ABC01 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
02.Apr.2018 |
|
Raghu |
|
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
02.Apr.2018 |
|
Raghu |
|
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
02.Apr.2018 |
|
Raghu |
|
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
02.Apr.2018 |
|
Raghu |
|
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
02.Apr.2018 |
|
Raghu |
|
7 |
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
8 |
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
9 |
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
10 |
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
11 |
37 |
ABC37 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
12 |
41 |
ABC41 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
13 |
45 |
ABC45 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
14 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Checked Library Infomation Excel 2003 Excel 2007 Excel 2010
Some sample data for other Posts and Threads:
http://www.eileenslounge.com/viewtopic.php?f=30&t=29652
Using this code:
Code:
Sub Its() ' snb 2017
Dim It As Variant
For Each It In ThisWorkbook.VBProject.References
Dim strIts As String
Let strIts = strIts & "Description:" & vbTab & It.Description & vbCr & "Name:" & vbTab & vbTab & It.Name & vbCr & "Buitin:" & vbTab & vbTab & It.BuiltIn & vbCr & "Minor:" & vbTab & vbTab & It.minor & vbCr & "Major:" & vbTab & vbTab & It.major & vbCr & "FullPath:" & vbTab & vbTab & It.fullpath & vbCr & "GUID:" & vbTab & vbTab & It.GUID & vbCr & "Type:" & vbTab & vbTab & It.Type & vbCr & "Isbroken:" & vbTab & vbTab & It.isbroken & vbCr & vbCr
Next It
Debug.Print strIts ' From VB Editor Ctrl+g to get Immediate Window from which info can be copied
End Sub
Here some results. ( If anyone passing has other Excel versions and would like to pass on what the code above gives, then that would be nice, thanks :) )
Excel 2007
Code:
Description: Visual Basic For Applications
Name: VBA
Buitin: Wahr
Minor: 0
Major: 4
FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
GUID: {000204EF-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Excel 12.0 Object Library
Name: Excel
Buitin: Wahr
Minor: 6
Major: 1
FullPath: C:\Program Files\Microsoft Office\Office12\EXCEL.EXE
GUID: {00020813-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: OLE Automation
Name: stdole
Buitin: Falsch
Minor: 0
Major: 2
FullPath: C:\Windows\system32\stdole2.tlb
GUID: {00020430-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Office 12.0 Object Library
Name: Office
Buitin: Falsch
Minor: 4
Major: 2
FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE12\MSO.DLL
GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type: 0
Isbroken: Falsch
Description: Microsoft Word 12.0 Object Library
Name: Word
Buitin: Falsch
Minor: 4
Major: 8
FullPath: C:\Program Files\Microsoft Office\Office12\MSWORD.OLB
GUID: {00020905-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Excel 2003
Code:
Description: Visual Basic For Applications
Name: VBA
Buitin: Wahr
Minor: 0
Major: 4
FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
GUID: {000204EF-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Excel 11.0 Object Library
Name: Excel
Buitin: Wahr
Minor: 5
Major: 1
FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
GUID: {00020813-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: OLE Automation
Name: stdole
Buitin: Falsch
Minor: 0
Major: 2
FullPath: C:\Windows\system32\stdole2.tlb
GUID: {00020430-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Office 11.0 Object Library
Name: Office
Buitin: Falsch
Minor: 3
Major: 2
FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type: 0
Isbroken: Falsch
Description: Microsoft Word 12.0 Object Library
Name: Word
Buitin: Falsch
Minor: 4
Major: 8
FullPath: C:\Program Files\Microsoft Office\Office12\MSWORD.OLB
GUID: {00020905-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Excel 2010
Code:
Description: Visual Basic For Applications
Name: VBA
Buitin: Wahr
Minor: 1
Major: 4
FullPath: C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL
GUID: {000204EF-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Excel 14.0 Object Library
Name: Excel
Buitin: Wahr
Minor: 7
Major: 1
FullPath: C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE
GUID: {00020813-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: OLE Automation
Name: stdole
Buitin: Falsch
Minor: 0
Major: 2
FullPath: C:\Windows\SysWOW64\stdole2.tlb
GUID: {00020430-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Description: Microsoft Office 14.0 Object Library
Name: Office
Buitin: Falsch
Minor: 5
Major: 2
FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE14\MSO.DLL
GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type: 0
Isbroken: Falsch
Description: Microsoft Word 14.0 Object Library
Name: Word
Buitin: Falsch
Minor: 5
Major: 8
FullPath: C:\Program Files (x86)\Microsoft Office\Office14\MSWORD.OLB
GUID: {00020905-0000-0000-C000-000000000046}
Type: 0
Isbroken: Falsch
Test data supplied by Thainguyen
To support solution to this Thread:
http://www.excelfox.com/forum/showth...and-send-email
Test data supplied by Thainguyen for this Thread :
http://www.excelfox.com/forum/showth...and-send-email
Code:
Using Excel 2007 32 bit
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
N |
|---|
1 |
Equipment PM |
|
|
|
|
|
|
|
|
|
|
|
2 |
Machine EQ.ID |
Manufacture |
Model |
Description |
Serial Number |
Weekly
Date of Service |
Weekly
Next Service |
Monthly
Date of Service |
Monthly
Next Service |
Quarterly
Date of Service |
Quarterly
Next Service |
Softwear |
3 |
|
|
|
|
|
|
|
|
|
|
|
|
4 |
1 |
JUKI |
GKG GL |
GL SCREEN PRINTER |
A123 |
06.04.2018 |
13.04.2018 |
15.03.2018 |
12.04.2018 |
N/A |
N/A |
|
5 |
2 |
JUKI |
KE-1070L |
SMT Placement Machine |
A124 |
11.04.2018 |
18.04.2018 |
28.03.2018 |
25.04.2018 |
N/A |
N/A |
|
6 |
9 |
ACE Production |
KISS-101B |
Selective Wave Solder |
A125 |
06.04.2018 |
13.04.2018 |
15.03.2018 |
12.04.2018 |
N/A |
N/A |
|
7 |
59 |
Heller |
1826 MK5 |
Reflow Oven |
A126 |
N/A |
N/A |
16.03.2018 |
13.04.2018 |
N/A |
N/A |
|
8 |
62 |
Exit Sign -- N/A -- Exit Lights |
N/A |
N/A |
A127 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
9 |
69 |
South-Tek System |
N2-Gen 35ST |
Nitrogen Generator |
A128 |
10.04.2018 |
17.04.2018 |
N/A |
N/A |
09.03.2018 |
06.04.2018 |
|
10 |
75 |
ACE Production |
KISS-102 |
Selective Wave Solder |
A129 |
16.04.2018 |
23.04.2018 |
N/A |
N/A |
N/A |
N/A |
|
11 |
101 |
FKN system |
N100 Nibbler |
Dispensing |
A130 |
N/A |
N/A |
N/A |
N/A |
04.04.2018 |
02.05.2018 |
|
12 |
109 |
Mycronic |
MY200sx |
SMT Machine |
A131 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
13 |
112 |
X-TEK |
XTV-160 |
X-Ray System |
A132 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
14 |
113 |
MIRTEC |
MV-6 OMNI |
AOI |
A133 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
15 |
116 |
JUKI |
KE-2060RL |
SMT Placement Machine |
A134 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
16 |
127 |
ELGI |
EG22-150 |
Air Compressor |
A135 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
17 |
128 |
Juki |
KE-2050 |
SMT |
A136 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
18 |
137 |
Juki |
K3 |
Screen printer |
A137 |
06.04.2018 |
13.04.2018 |
N/A |
N/A |
N/A |
N/A |
|
19 |
141 |
Heller |
1826 MK5 |
Reflow Oven |
A138 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
20 |
142 |
NISSAN |
MCU-112A331.V |
Forklift |
A139 |
N/A |
N/A |
N/A |
N/A |
15.02.2018 |
15.03.2018 |
|
21 |
142 |
NISSAN/yearly oil change and lube |
MCU-112A331.V |
Forklift |
A140 |
N/A |
N/A |
N/A |
N/A |
N/A |
N/A |
|
22 |
|
|
|
|
|
|
|
|
|
|
28.01.1900 |
|
23 |
|
|
|
|
|
|
|
|
|
|
|
|
Worksheet: Equipment PM
1 Attachment(s)
Re Post code with Code tags
To support this Thread
http://www.excelfox.com/forum/showth...0679#post10679
Re post code in Code tags, Like ....
Please use CODE TAGS if you are writing codes in your post.
To use code tags,
either
select your entire code and press the code tag button # in the editor below,
or
simply type your code as below
[Code]Your Code Here[/Code]
[Code]
Your Code Here
[/Code]
[Code]
Private Sub cmdNot_Click()
Dim OutApp As Object
Dim OutMail As Object
…………………….
……………..
End Sub
[/Code]
BBCodeCodeTags.JPG : https://imgur.com/4HunNcs
Attachment 2060
_.__________________
If you post using Code tags, then it will come out in the final post in a Code Window, like this:
Code:
Private Sub cmdNot_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Dim mSubject As String
Dim signature As String
Dim fname As String
Dim mBody As String
Dim rng As Range
Dim rng1 As Range
Dim ws As Worksheet
Dim mailTo As String
Set ws = Sheets("MRO")
fname = ws.Range("B4")
mSubject = "MRO " & " For " & Range("C6").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'mBody = "2-SO\Material Request Form .xlsm"
Dim Path As String
mBody = "<font size=""3"" face=""Calibri"">" & _
"Dear Team,<br><br>" & _
"Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
fileName & ".xlsm" & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & Path & fileName & ".xlsm" & _
""">Files are saved here</A>" & "-->" & Range("C6").Value & _
"<br><br>Best Regards," & _
"<br><br></font>"
With OutMail
.display
End With
signature = OutMail.body
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With OutMail
'.To = "email"
.To = ""
.CC = ""
.BCC = ""
.Subject = mSubject
'.body = "Dear Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet"
'.htmlbody = RangetoHTML(rng)
.htmlbody = mBody
'.Attachments.Add fileName
.display
End With
'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1")
ActiveWorkbook.Close False
ActiveWorkbook.Close
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Share account for testing file access from a hyperlink in a received EMail
Share account for testing file access from a hyperlink in a received EMail
In support of a possible solution to this post in this Thread:
http://www.excelfox.com/forum/showth...0724#post10724
It is required to have a simple hyperlink to an Excel File appear in the received Email sent to members of a team.
I am not sure currently how to get a link directly to the File.
An second alternative involves storing the file at a File sharing site and using the link to the file as the URL part of a hyperlink.
This post discusses the setting up of such an account to allow storing of, and sharing via a supplied link to, the file.
As an example of a file sharing site we consider the free version of box.net
Some googling my be needed to finally get at the free version which may go under the name of “free” , “Individual rate”, “Personal free”
Currently you need to find your way to the free 10GB offer. This is currently at this link:
https://account.box.com/signup/n/personal#fbms6
Free10GB box net account register.JPG : https://imgur.com/NB3GThi
Note , by registering, you can choose a language to suit you.
Free10GB Select language .JPG : : https://imgur.com/aNzW1kq
( You can change the language to a different one after registering also
Free10GB Change language .JPG : https://imgur.com/IosqbAI )
For this registering , I use the created gmail account used for experiments in the current thread which this post supports, excellearning12@gmail.com ( excelfox Thread : http://www.excelfox.com/forum/showth...and-send-email )
The password I pass on privately to those needing
Free10GB box net account register 2.JPG : https://imgur.com/Y2pLogO
Free10GB box net account register 3.JPG : https://imgur.com/QhCR8fP
Free10GB box net account register Verify Email 4.JPG : https://imgur.com/ffG7erw
Various steps are then gone through, they may be slightly different to the following:
At some point you should you should see the possibility to upload a file, following steps similar to these:
Free10GB box net 5 .JPG : https://imgur.com/lNWvQwF
To upload a file and get a URL link to use in a hyperlink to it:
Upload Files:
Free10GB box net 6 .JPG : https://imgur.com/rTU1Xbk
Select a file:
Free10GB box net 7 .JPG : https://imgur.com/wKKlqoO
Select share to obtain a URL link to the file :
Free10GB box net 8 .JPG : https://imgur.com/R3VbyhR
Copy link to be used in Hyperlink :
Free10GB box net 9 .JPG : https://imgur.com/8yaYwaK
