-
Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)
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>
Edit November 2019 : Some post are still needed as referrenced from other Threads.
Other post will be used for other tests , or for appendixes from other newer Threads
Alan
Some observations around July 2023......
This Thread, number 2056, and this post number #post9501 , is probably the original Appendix Thread, but renaimed to App2 around November 2019
The copy made probably around November 2019 is probably left with original Title. Its Thread nujber is 2345, and the first post in it is post number #post19608 https://www.excelfox.com/forum/showt...L-Tables-etc-)
I seem to have added further to that copy with the original Title, and forgot this one which is falling down the list ..... - Oh Bollox August 1 2023, - I seem to have totally deleted that Thread when I deleted the second and third post in it. (The second post was a copy of the first, so maybe that caused the problem. Bollox So I start using it again for a while https://www.excelfox.com/forum/showt...ll=1#post22077
https://www.youtube.com/channel/UCnx...RbjOo_MO54oaHA
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
-
Grid coordinates for a Range using [ ] and Evaluate(" ") through a named Range
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 : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"
This code is in support of other Posts in various Threads. ( I will edit the Links as I reference this post )
For example:
http://www.excelforum.com/showthread...t=#post4400666
The code takes in a hard coded Range, A1:E10.
That Range is given a Name as held in the Names Register of a Worksheet.
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 start column
sClm is the column count
stpClm is the stop column
Rs is the start row
sRw is the rows count
stpRw is the stop row
Code:
'10 ' It is a Range Name Test : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"
Sub snRgNameTest() ' 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 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 Dim ReturnedsnRgName As String
130 Let ReturnedsnRgName = snRg.Name ' The returned name is full, like "NPueyoGyanArraySlicing!$A$1:$E$10". This will not work in the Address Formulas
140 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" 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
150 Let NameOnly = Replace((ReturnedsnRgName), "!", "", (InStr(1, (ReturnedsnRgName), "!")))
160 If InStr(NameOnly, "!") > 0 Then MsgBox prompt:="NameOnly is " & vbCr & """" & NameOnly & """" & vbCr & "so will chop off up to and including the ""!""": Let NameOnly = Replace((NameOnly), "!", "", (InStr(1, (NameOnly), "!"))) ' Just to demo that you need to do this if you are not sure that a ! is there, or the code line would error if no ! was in there..
170 '
180 ' Count, Start, and Stop of columns in an Area of contiguous cells in a Spreadsheet
190 Dim sClm 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 sClm = Evaluate("columns(snRgNme)") ' = 5
210 'Let sClm = Evaluate("columns(RetunedsnRgName)") 'Run time Error as expected
220 Let sClm = [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 sClm = [columns(RetunedsnRgName)] 'Run time Error as expected
240 Let sClm = [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 Cs As Long 'Variable for Start Column
270 Let Cs = Evaluate("column(A1:E10)")(1)
280 Let Cs = Evaluate("column(snRgNme)")(1) ' = 1
290 Let vTemp = [column(snRgNme)]: vTemp = vTemp(1) ' Anololie erklart: http://www.excelforum.com/showthread.php?t=1141369&p=4398930&highlight=#post4398930 http://www.excelforum.com/showthread.php?t=1141369&p=4398966#post4398966
300 Let Cs = [column(A1:E10)]()(1)
310 Let Cs = [column(snRgNme)]()(1)
320 '
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 = Cs + (sClm - 1) ' = 5
350 ' [ ]
360 Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 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)")))
430 '
440 ' Start, Count and Stop of rows in an Area of contiguous cells in a Spreadsheet
450 Dim sRw As Long 'Rows Count
460 Let sRw = Evaluate("rows(snRgNme)")
470 Let sRw = [rows(snRgNme)]
480 Let sRw = [rows(A1:E10)]
490 Let vTemp = Evaluate("row(snRgNme)") ' = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
500 Dim Rs As Long 'Start Row
510 Let Rs = 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 Rs = Evaluate("row(snRgNme)")(1, 1)
530 Let vTemp = [row(snRgNme)]: vTemp = vTemp(1, 1)
540 Let Rs = [row(A1:E10)]()(1, 1)
550 Let Rs = [row(snRgNme)]()(1, 1)
560 '
570 Dim stpRw% 'Stop Row
580 Let stpRw = Rs + (sRw - 1)
590 Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 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 '
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
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
-
2 Attachment(s)
Code For Nelson
Hi Nelson,
I think both
_ the ways to do this,
_and the possibly output forms
are infinite
_ You must try to be a bit more precise in exactly what you want.
_ I have done another fairly simple code:
It is here:
http://www.excelfox.com/forum/showth...0047#post10047
It runs though all the Worksheets to calculate normal overtime and holiday overtime. The total added for all Worksheets is displayed in a message box:
NelsonMessageBox.jpg http://imgur.com/XSvQpQi
Attachment 1863
I expect the code is not yet want you finally want. It tells you the total sum for Normal Overtime and Holiday overtime.
( I still do not understand what calculations should be done for total days :confused: )
Please start a new Thread here: _.. http://www.excelfox.com/forum/forumd...p/2-Excel-Help
_.. Please try again to explain exactly what you want.
_.. I will then look at it again for you on Monday
:)
Alan
Code:
Code:
' An Initial code for Nelson for Post in this Forum http://www.excelfox.com/forum/forumdisplay.php/2-Excel-Help
Sub SomeingSumTotals() ' https://www.dropbox.com/s/u76eo5trrtppgoi/SAMPLE2.xlsx?dl=0
Rem 1) Worksheets info.
Dim WsStear As Worksheet ' 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: 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
Rem 2) varables for some totals ;)
Dim NOHrsV2 As Double, HOHrsV2 As Double, TDays As Long
Let NOHrsV2 = 0: Let HOHrsV2 = 0: Let TDays = 0
Rem 3) Loop through worksheets and give some Totals
Dim Cnt As Long ' Loop Bound variable count for going through all worksheets
For Cnt = 1 To ThisWorkbook.Worksheets.Count
Set WsStear = ThisWorkbook.Worksheets.Item(Cnt) ' 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 lr 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. )
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("A2") ' Worksheets Range(" ") Property used to return Range object of first cell in second row
Dim arrInNorm() As Variant, arrInOver() As Variant ' In the next lines the .Value2 Property is applied a Range object which presents the the 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, 1).Value2 ' 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.. ) )
Let arrInOver() = FstDtaCel.Offset(0, 9).Resize(lr - 1, 1).Value2 ' 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.
Dim ShtCnt As Long ' Loop Bound Variable Count for hours columns looping
For ShtCnt = 1 To UBound(arrInNorm(), 1) Step 1
If arrInNorm(ShtCnt, 1) <> 0 And arrInOver(ShtCnt, 1) <> 0 Then Let NOHrsV2 = NOHrsV2 + arrInOver(ShtCnt, 1)
If arrInNorm(ShtCnt, 1) = 0 And arrInOver(ShtCnt, 1) <> 0 Then Let HOHrsV2 = HOHrsV2 + arrInOver(ShtCnt, 1)
Next ShtCnt
Next Cnt
Rem 4) Output some totals ;)
MsgBox prompt:="Normal Overtime is " & NOHrsV2 * 24 & vbCrLf & "Holiday Overtime is" & HOHrsV2 * 24 ' NelsonMessageBox.jpg http://imgur.com/XSvQpQi
'4b) Tell you Totals ' Sub Speach() ' Richard Buttrey http://www.excelforum.com/showthread.php?t=1164765&p=4535112#post4535112
Dim Saps As Object
Set Saps = CreateObject("SAPI.SpVoice")
Saps.Speak "Hello Nelson. These are Sum totals for Normal Overtime and Holiday Overtime for the two Worksheets you gave.. Normal Overtime is " & NOHrsV2 * 24 & ".. Holiday Overtime is " & HOHrsV2 * 24 & ".. I expect this is not yet quite what you want."
' ' End Sub
End Sub
Test
https://youtu.be/xLCWtC6UYrM?t=150
https://www.youtube.com/watch?v=xLCW...0C3q3gx4AaABAg
https://www.microsoft.com/en-us/soft...load/windows10
Hold keys Ctrl+Shift , then press key I to get development mode
Hit the 3 dots
More tools
https://www.microsoft.com/de-de/soft...d/windows10ISO
https://i.postimg.cc/7LznW4QR/Hold-k...pment-mode.jpg
https://i.postimg.cc/0yFCnjZm/Hit-the-3-dots.jpg
https://i.postimg.cc/Dw8g1LQn/More-Tools.jpg
https://i.postimg.cc/5N9pNZ6H/More-t...conditions.jpg
https://i.postimg.cc/RhdRLTbV/User-A...-Chrome-OS.jpg https://i.postimg.cc/050cv82R/Chrome-OS.jpg
https://i.postimg.cc/wvhF7zXN/Hit-Refresh.jpg
https://www.microsoft.com/de-de/soft...d/windows10ISO
https://i.postimg.cc/hGQ2RThp/Edition-Multi-Edition.jpg
https://i.postimg.cc/VvmgthgV/English-US.jpg
https://i.postimg.cc/7Z6BXp4v/Generic-Keys.jpg
https://i.postimg.cc/wT94R1bj/Generic-Keys.jpg
https://i.postimg.cc/c4T9RdVM/Generic-Keys.jpg
https://i.postimg.cc/1txJmXqP/Generic-Keys.jpg
Generic keys https://www.youtube.com/watch?t=440
https://christitus.com/ntlite-guide/
Dec 2023 https://eileenslounge.com/viewtopic.php?f=56&t=40330
Link zu dieser Galerie: https://postimg.cc/gallery/m4f5hF9
https://i.postimg.cc/xdvDsfrk/64-Bit.jpg
https://i.postimg.cc/j2dbwGFD/a-Edit...ti-Edition.jpg
https://i.postimg.cc/SRTpWDBD/b-English-US.jpg
https://i.postimg.cc/LXmdwcRx/d-Hold...pment-mode.jpg
https://i.postimg.cc/50pcVs2b/e-Hit-the-3-dots.jpg
https://i.postimg.cc/SNR4yb95/f-More-Tools.jpg
https://i.postimg.cc/7YRkhtML/g-More...conditions.jpg
https://i.postimg.cc/CKTpHZ2T/h-User...-Chrome-OS.jpg
https://i.postimg.cc/tR2yQ4sW/hi-Chrome-OS.jpg
https://i.postimg.cc/13NZq0Jr/j-Hit-Refresh.jpg
-
Code for Nelson in this Thread
http://www.excelfox.com/forum/showth...liday-overtime
http://www.excelfox.com/forum/showth...0060#post10060
Code:
Option Explicit
Sub IJAdjustTotalAllWorksheet() ' http://www.excelfox.com/forum/showth...0060#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 NOHrsV2 As Double, HOHrsV2 As Double ' I am proposing to use the underlying number an adjust as necerssary to get the reqired format
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
Let NOHrsV2 = 0: Let HOHrsV2 = 0 ' The varaibles are emtied before run for each worksheet
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 arrDte() As Variant, arrTotHrs() 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 arrDte() = FstDtaCel.Offset(0, 4).Resize(lr, 1).Value ' E ' 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...t=#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.. )
Let arrTotHrs() = FstDtaCel.Offset(0, 7).Resize(lr, 1).Value ' H ' 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 arrInNorm() As Variant, arrInOver() As Variant
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
'3c) Inner loop for rows
Dim ShtCnt As Long ' Loop Bound Variable Count for hours columns looping
For ShtCnt = 1 To UBound(arrDte(), 1) Step 1 '------------------- For "rows" in data arrays
'3d) We need to check for a Holy?? Holiday?? Friday?? 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
Let Dte = arrDte(ShtCnt, 1): Let DteNo = Weekday(Dte, [vbSunday]) ' I do not really nead this extra variable, but for dates I prefer always to do this to help in looking into the variable in Debugging
If DteNo = 6 Then ' 6 I think is Friday, Nelson's Holy HoliDay ?
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
Else ' No Holy Holiday
End If
'3e)
If arrInNorm(ShtCnt, 1) <> 0 And arrInOver(ShtCnt, 1) <> 0 Then Let NOHrsV2 = NOHrsV2 + arrInOver(ShtCnt, 1) ' Normal Overtime is simply calculated from summing hours in column J only If there are Overtime hours in column J And there are Normal hours are in column I.
If arrInNorm(ShtCnt, 1) = Empty And arrInOver(ShtCnt, 1) <> 0 Then Let HOHrsV2 = HOHrsV2 + arrInOver(ShtCnt, 1) ' Holiday Overtime is simply calculated from summing hours in column J only If there are Overtime hours in column J And there are no Normal hours are in column I.
Next ShtCnt '--------------------------End Inner loop for rows-----
'3f) Paste out final Totals and days to current Worksheet
Let wsStear.Range("G34").Value = NOHrsV2 * 24 'Normal Overtime is held in Array as fraction of a day
Let wsStear.Range("J34").Value = HOHrsV2 * 24 'Holiday Overtime is held in Array as fraction of a day
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
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
Next Cnt '==End main Loop==============================================
End Sub
' Rem Ref '_- http://www.excelfox.com/forum/showth...0062#post10062
'_- http://www.excelfox.com/forum/showth...0012#post10012
-
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
-
'Testies: NOT FINAL CODE --- TEST CODE FOR LATER REFERRENCE ! TEST ! --- Testies to you '_-
' Code for approximately Posts: 14 - 23
Sub IJAdjustLAddTotalAllWorksheetCode3()
For Thread ' http://www.excelfox.com/forum/showth...0078#post10078
Code:
'Testies: NOT FINAL CODE --- TEST CODE FOR LATER REFERRENCE ! TEST ! --- Testies to you '_-
' Code for approximately Posts: 14 - 23
Sub IJAdjustLAddTotalAllWorksheetCode3() 'http://www.excelfox.com/forum/showthread.php/2144-Code-Required-to-calculate-number-of-days-worked-normal-overtime-and-holiday-overtime?p=10078#post10078
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.
Let lr = 30 ' maybe nelson means thís ? "...For all Month no. of days we take as 30 only..."
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 arrL() 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 arrL(1 To UBound(arrInNorm(), 1), 1 To 1) ' Any array first dimension ("row") will do
Dim arrAbscentK() As String 'K column to have ABSCENT in for person Abscent on not Holiday
ReDim arrAbscentK(1 To UBound(arrInNorm(), 1), 1 To 1)
'Must Loop to get interior color as 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
Dim ValidHoliday As Boolean: Let ValidHoliday = True 'Assume for now Holiday days are valid for Holiday adjustments
For ShtCnt = 1 To UBound(arrDteClr(), 1) Step 1 '------------------- For "rows" in data arrays
'3d) We need to check Interior color, and a few other things, 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 ' We have a Holiday, ...but... have some other checks
If Not (ShtCnt = 1 Or ShtCnt = UBound(arrDteClr(), 1)) Then ' ....but... Possible futher checks for not adjusting Normal Total Hrs to overtime and remove normal Hrs
'It is possible to check for absent before and after current day
If (arrTotHrs(ShtCnt - 1, 1) <> Empty And arrTotHrs(ShtCnt + 1, 1)) <> Empty Then '...."...holiday is deducted if the person does not come the day before and after the holiday..."....
Let ValidHoliday = False
Else
Let ValidHoliday = True
End If
Else 'It is not possible for absence before AND after to check for absence as one will lie in last or next month
End If ' We remmain at default or last set true or just set true
'We had Holiday ...
If ValidHoliday = True Then ' ...and all conditions for valid Holiday pay adjustments
'Conditions met to adjust make all of 1 less of Normal Hrs to overtime
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 arrL(ShtCnt, 1) = "H" ' ' (iv)H Give string, "" value of H for Holiday in Admin's help column
Else ' We had a Holiday but abscence before and after, we need
Let ValidHoliday = True 'we need to reset to true
End If
Else ' No Holy Holiday
Let arrL(ShtCnt, 1) = "N" ' give string N for normal ' (iv)N
End If
If arrTotHrs(ShtCnt, 1) = Empty And Not arrDteClr(ShtCnt, 1) = 65535 Then Let arrAbscentK(ShtCnt, 1) = "ABSENT" ' column K absent days should be marked as ABSENT.
'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("G34").Value = "=SUMIF(L1:L" & lr & ",""N"",J1:J" & lr & ")*24"
Let wsStear.Range("J34").Value = "=SUMIF(L1:L" & lr & ",""H"",J1:J" & lr & ")*24"
Let wsStear.Range("C34").Value = "=COUNT(F1:F31)" ' 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, 11).Resize(lr, 1).Value2 = arrL() ' L
Let FstDtaCel.Offset(0, 10).Resize(lr, 1).Value2 = arrAbscentK() ' K
'3h) Set Booleans for
Next Cnt '==End main Loop==============================================
End Sub
-
Post 22 Before ( HTML )
Post 22 Before
http://www.excelfox.com/forum/showth...0090#post10090
<b>Excel 2007 32 bit</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">21.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">22.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">23.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">15:00</td><td style="text-align: right;;">8:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">0:00</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">24.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">25.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">26.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">27.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">17:00</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">28.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">29.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">30.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">31.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">1.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">2.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">3.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">4.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">5.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">6.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">7.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">8.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">20</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">9.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">21</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">10.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">22</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">11.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">23</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">12.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">24</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">13.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">25</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">14.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td></tr><tr ><td style="color: #161120;text-align: center;">26</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">15.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td></tr><tr ><td style="color: #161120;text-align: center;">27</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">16.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td></tr><tr ><td style="color: #161120;text-align: center;">28</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">17.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td></tr><tr ><td style="color: #161120;text-align: center;">29</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">18.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td></tr><tr ><td style="color: #161120;text-align: center;">30</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">19.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">31</td><td style="text-align: right;;">121</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">20.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">32</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">33</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">34</td><td style="font-weight: bold;background-color: #FFFFFF;;"></td><td style="font-weight: bold;;"></td><td style="text-align: center;;"></td><td style="font-weight: bold;text-align: right;;">Normal Overtime -----></td><td style="font-weight: bold;;"></td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">Holiday Overtime -----></td><td style="font-weight: bold;;"></td></tr></tbody></table><p style="width:1.8em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">121</p><br /><br />
-
Post 22 Before ( BB Code )
Post 22 Before ( BB Code )
http://www.excelfox.com/forum/showth...0090#post10090
Using Excel 2007 32 bit
Row\Col |
C |
D |
E |
F |
G |
H |
I |
J |
1 |
121 |
TEAM LEADER |
21.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
2 |
121 |
TEAM LEADER |
22.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
3 |
121 |
TEAM LEADER |
23.Dec.16 |
7:00 |
15:00 |
8:00 |
9:00 |
0:00 |
4 |
121 |
TEAM LEADER |
24.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
5 |
121 |
TEAM LEADER |
25.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
6 |
121 |
TEAM LEADER |
26.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
7 |
121 |
TEAM LEADER |
27.Dec.16 |
7:00 |
17:00 |
10:00 |
9:00 |
1:00 |
8 |
121 |
TEAM LEADER |
28.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
9 |
|
|
29.Dec.16 |
|
|
|
|
|
10 |
|
|
30.Dec.16 |
|
|
|
|
|
11 |
|
|
31.Dec.16 |
|
|
|
|
|
12 |
121 |
TEAM LEADER |
1.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
13 |
121 |
TEAM LEADER |
2.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
14 |
121 |
TEAM LEADER |
3.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
15 |
121 |
TEAM LEADER |
4.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
16 |
121 |
TEAM LEADER |
5.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
17 |
121 |
TEAM LEADER |
6.Jan.17 |
|
|
|
|
|
18 |
121 |
TEAM LEADER |
7.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
19 |
121 |
TEAM LEADER |
8.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
20 |
121 |
TEAM LEADER |
9.Jan.17 |
|
|
|
|
|
21 |
121 |
TEAM LEADER |
10.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
22 |
121 |
TEAM LEADER |
11.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
23 |
121 |
TEAM LEADER |
12.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
24 |
121 |
TEAM LEADER |
13.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
25 |
121 |
TEAM LEADER |
14.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
26 |
121 |
TEAM LEADER |
15.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
27 |
121 |
TEAM LEADER |
16.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
28 |
121 |
TEAM LEADER |
17.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
29 |
121 |
TEAM LEADER |
18.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
30 |
|
|
19.Jan.17 |
|
|
|
|
|
31 |
121 |
TEAM LEADER |
20.Jan.17 |
|
|
|
|
|
32 |
|
|
|
|
|
|
|
|
33 |
|
|
|
|
|
|
|
|
34 |
|
|
|
Normal Overtime -----> |
|
|
Holiday Overtime -----> |
|
Worksheet: Post22Before121
-
After from last two posts after running code :
Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorkshe etsCode4()
Using Excel 2007 32 bit
Row\Col |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
1 |
121 |
TEAM LEADER |
21.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
2 |
121 |
TEAM LEADER |
22.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
3 |
121 |
TEAM LEADER |
23.Dec.16 |
7:00 |
15:00 |
8:00 |
|
8:00 |
|
H |
4 |
121 |
TEAM LEADER |
24.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
5 |
121 |
TEAM LEADER |
25.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
6 |
121 |
TEAM LEADER |
26.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
7 |
121 |
TEAM LEADER |
27.Dec.16 |
7:00 |
17:00 |
10:00 |
9:00 |
1:00 |
|
N |
8 |
121 |
TEAM LEADER |
28.Dec.16 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
9 |
|
|
29.Dec.16 |
|
|
|
|
|
ABSENT |
N |
10 |
|
|
30.Dec.16 |
|
|
|
|
|
ABSENT |
|
11 |
|
|
31.Dec.16 |
|
|
|
|
|
ABSENT |
N |
12 |
121 |
TEAM LEADER |
1.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
13 |
121 |
TEAM LEADER |
2.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
14 |
121 |
TEAM LEADER |
3.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
15 |
121 |
TEAM LEADER |
4.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
16 |
121 |
TEAM LEADER |
5.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
17 |
121 |
TEAM LEADER |
6.Jan.17 |
|
|
|
|
|
|
H |
18 |
121 |
TEAM LEADER |
7.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
19 |
121 |
TEAM LEADER |
8.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
20 |
121 |
TEAM LEADER |
9.Jan.17 |
|
|
|
|
|
ABSENT |
N |
21 |
121 |
TEAM LEADER |
10.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
22 |
121 |
TEAM LEADER |
11.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
23 |
121 |
TEAM LEADER |
12.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
24 |
121 |
TEAM LEADER |
13.Jan.17 |
7:00 |
18:00 |
11:00 |
|
10:00 |
|
H |
25 |
121 |
TEAM LEADER |
14.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
|
N |
26 |
121 |
TEAM LEADER |
15.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
|
N |
27 |
121 |
TEAM LEADER |
16.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
|
N |
28 |
121 |
TEAM LEADER |
17.Jan.17 |
7:30 |
17:30 |
10:00 |
9:00 |
1:00 |
|
N |
29 |
121 |
TEAM LEADER |
18.Jan.17 |
7:00 |
18:00 |
11:00 |
9:00 |
2:00 |
|
N |
30 |
|
|
19.Jan.17 |
|
|
|
|
|
ABSENT |
N |
31 |
121 |
TEAM LEADER |
20.Jan.17 |
|
|
|
|
|
|
H |
32 |
|
|
|
|
|
|
|
|
|
|
33 |
|
|
|
|
|
|
|
|
|
|
34 |
25 |
|
|
Normal Overtime -----> |
39 |
|
Holiday Overtime -----> |
18 |
|
|
Worksheet: Aftert121
Using Excel 2007 32 bit
Row\Col |
B |
C |
D |
E |
F |
G |
H |
I |
J |
34 |
TOTAL NO. OF DAYS -----> |
=30-COUNTIF(K1:K31,"ABSENT") |
|
|
Normal Overtime -----> |
=SUMIF(L1:L31,"N",J1:J31)*24 |
|
Holiday Overtime -----> |
=SUMIF(L1:L31,"H",J1:J31)*24 |
Worksheet: After121
-
HTML After using Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorkshe etsCode4()
After from running code (HTML) :
Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorkshe etsCode4()
<b>Excel 2007 32 bit</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th><th>L</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">21.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">22.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">23.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">15:00</td><td style="text-align: right;;">8:00</td><td style="text-align: right;;"></td><td style="text-align: right;;">8:00</td><td style="text-align: right;;"></td><td style=";">H</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">24.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">25.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">26.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">27.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">17:00</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">28.Dec.16</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">29.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">ABSENT</td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">30.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">ABSENT</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">31.Dec.16</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">ABSENT</td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">1.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">2.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">3.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">4.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">5.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">6.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">H</td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">7.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">8.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">20</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">9.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">ABSENT</td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">21</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">10.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">22</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">11.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">23</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">12.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">24</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">13.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;"></td><td style="text-align: right;;">10:00</td><td style="text-align: right;;"></td><td style=";">H</td></tr><tr ><td style="color: #161120;text-align: center;">25</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">14.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">26</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">15.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">27</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">16.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">28</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">17.Jan.17</td><td style="text-align: right;;">7:30</td><td style="text-align: right;;">17:30</td><td style="text-align: right;;">10:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">1:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">29</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;;">18.Jan.17</td><td style="text-align: right;;">7:00</td><td style="text-align: right;;">18:00</td><td style="text-align: right;;">11:00</td><td style="text-align: right;;">9:00</td><td style="text-align: right;;">2:00</td><td style="text-align: right;;"></td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">30</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">19.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">ABSENT</td><td style=";">N</td></tr><tr ><td style="color: #161120;text-align: center;">31</td><td style=";">TEAM LEADER</td><td style="font-weight: bold;text-align: right;background-color: #FFFF00;;">20.Jan.17</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">H</td></tr></tbody></table><p style="width:9em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">After121</p><br /><br />
-
Totals output for last post ( HTML )
<b>Excel 2007 32 bit</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">34</td><td style="font-weight: bold;background-color: #FFFFFF;;">TOTAL NO. OF DAYS -----></td><td style="font-weight: bold;background-color: #FFFFFF;;">25</td><td style="font-weight: bold;;"></td><td style="text-align: center;;"></td><td style="font-weight: bold;text-align: right;;">Normal Overtime -----></td><td style="font-weight: bold;;">39</td><td style="text-align: right;;"></td><td style="font-weight: bold;text-align: right;;">Holiday Overtime -----></td><td style="font-weight: bold;;">18</td></tr></tbody></table><p style="width:9em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">After121</p><br /><br /><table width="85%" cellpadding="2.5px" rules="all" style=";border: 2px solid black;border-collapse:collapse;padding: 0.4em;background-color: #FFFFFF" ><tr><td style="padding:6px" ><b>Worksheet Formulas</b><table cellpadding="2.5px" width="100%" rules="all" style="border: 1px solid;text-align:center;background-color: #FFFFFF;border-collapse: collapse; border-color: #A6AAB6"><thead><tr style=" background-color: #E0E0F0;color: #161120"><th width="10px">Cell</th><th style="text-align:left;padding-left:5px;">Formula</th></tr></thead><tbody><tr><th width="10px" style=" background-color: #E0E0F0;color: #161120">C34</th><td style="text-align:left">=30-COUNTIF(<font color="#0000FF">K1:K31,"ABSENT"</font>)</td></tr><tr><th width="10px" style=" background-color: #E0E0F0;color: #161120">G34</th><td style="text-align:left">=SUMIF(<font color="#0000FF">L1:L31,"N",J1:J31</font>)*24</td></tr><tr><th width="10px" style=" background-color: #E0E0F0;color: #161120">J34</th><td style="text-align:left">=SUMIF(<font color="#0000FF">L1:L31,"H",J1:J31</font>)*24</td></tr></tbody></table></td></tr></table><br />
-
Top Part of Code 4 for Nelson
Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorkshe etsCode4()
This is the first part of a single code.
The second part shpuld be copied directly under the first part in the same code module
For this Post
' http://www.excelfox.com/forum/showth...iday-overtime?
Code:
'10 ' Code 4 for Nelson ' Post 27 http://www.excelfox.com/forum/showthread.php/2144-Code-Required-to-calculate-number-of-days-worked-normal-overtime-and-holiday-overtime?p=10094#post10094
Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorksheetsCode4() 'http://www.excelfox.com/forum/showthread.php/2144-Code-Required-to-calculate-number-of-days-worked-normal-overtime-and-holiday-overtime?p=10078#post10078
20 Rem 1) Workbooks Info.
30 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.)
40 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
50 Dim wsStear As Worksheet ' Used for each Worksheet counting Tabs from left from 1 To Total
60 Rem 2) varables for some totals ;)
70 'Const TDays As Long = 30 'Total days just taken as 30 INITIALLY ' 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. )
80 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..
90 Rem 3) Loop through worksheets and give some Totals
100 Dim Cnt As Long ' Loop Bound variable count for going through all worksheets
110 '3a) main Loop start=====================================================
120 For Cnt = 1 To Wb.Worksheets.Count ' The Worksheets collection Object Property returns the number of worksheet items in the Workbook
130 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
140 Dim lr As Long ' Used for last row number in column E ( The number of “Entries” is taken as the filled dates in column E )
150 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.
160 'Let lr = 30 ' maybe nelson means thís ? "...For all Month no. of days we take as 30 only..." For all Months, the “TOTAL NO. OF DAYS” ( to be placed in cell C34 ) is not necessarily the number of days worked.
170 Let lr = wsStear.Range("E33").End(xlUp).Row ' To allow text below row 33
180 'TOTAL NO. OF DAYS The formula for calculating this is:
190 ' _Assuming the employee is not Absent for any day, then the “TOTAL NO. OF DAYS” is always taken as 30
200 ' _ If the employee has one or more normal days of absence, ( normal days with no total working hours ), then the formula for calculating “TOTAL NO. OF DAYS” is as follows:
210 ' TOTAL NO. OF DAYS = 30 – ( Count of “ABSENT” )
220 Dim FstDtaCel As Range: Set FstDtaCel = wsStear.Range("A1") 'Top Left data ' Worksheets Range(" ") Property used to return Range object of first cell in second row
230 '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
240 Dim arrInNorm() As Variant, arrInOver() As Variant ' In the next lines the .Value2 or .Value "values" 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
250 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 ??
260 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
270 Dim arrTotHrs() As Variant ' ,' ## ' arrDteClr() As Variant
280 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.. )
290 ' 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
300 'Column L ( help column ) Column L ( help column )
310 ' Nelson has chosen the second code. It puts formulas in cells C34, G34, and J34.
320 ' This requires “H” or “N” to indicate Holiday or Normal working day. This will be written by the code in column L
330 Dim arrL() 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
340 ReDim arrL(1 To UBound(arrInNorm(), 1), 1 To 1) ' Any array first dimension ("row") will do
350 '“ABSENT” “ABSENT” ( to be written in some rows in Column K by the program )
360 ' Count of “ABSENT” is the number of occurrences of ABSENT in column K in the final ( After ) Worksheet “ABSENT” is to be written in some rows of column K by the code under certain criteria.
370 ' ( “ABSENT” is not necessarily the normal working days in which an employee is absent and / or has no total working hours. )
380 ' “ABSENT” is to be written in column K by the code under the following criteria:
390 ' _ For the rows of all normal days when the employee has no working hours, ( days when the employee is absent ), “ABSENT” is to be written in column K.
400 ' _ In addition , should it occur that an employee is absent for both the days before and after a holiday, then for the ( Holiday ) row in between those two days, “ABSENT” is to be written in column K.
410 ' ( No consideration of this ““ABSENT” criteria thereof” is made for the case of a Holiday at the first or last “Entries” )
420 Dim arrAbscentK() As String 'K column to have ABSCENT in for person Absent on not Holiday or Holiday written in K cloumn as ABSENT
430 ReDim arrAbscentK(1 To UBound(arrInNorm(), 1), 1 To 1)
440 'Must Loop to get interior color as 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
-
Sub IJAdjust_LAdd_AbsentKAdd_TotalsFormulas_AllWorkshe etsCode4() Part 2
For Post http://www.excelfox.com/forum/showth...0094#post10094
This is the second part os a single code.
This second part shpuld be copied directly under the first part in the same code module
Code:
'440 'Must Loop to get interior color as 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
450 Dim arrDteClr() As Double, rngDts As Range
460 Set rngDts = FstDtaCel.Offset(0, 4).Resize(lr, 1)
470 Dim Rws As Long: ReDim arrDteClr(1 To lr, 1 To 1) ' so must loop in each Interior color value
480 For Rws = 1 To UBound(arrDteClr(), 1) Step 1 'InnerLoop for dates background colors
490 Let arrDteClr(Rws, 1) = rngDts.Item(Rws, "A").Interior.Color
500 Next Rws
510 '3c) Inner loop for rows
520 Dim ShtCnt As Long ' Loop Bound Variable Count for hours columns looping
530 Dim ValidHoliday As Boolean: Let ValidHoliday = True 'Assume for now Holiday days are valid for Holiday adjustments
540 For ShtCnt = 1 To UBound(arrDteClr(), 1) Step 1 '------------------- For "rows" in data arrays
550 '3d) We need to check Interior color, and a few other things, 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
560 If arrDteClr(ShtCnt, 1) = 65535 Then ' We have a Holiday, ...but... have some other checks
570 If Not (ShtCnt = 1 Or ShtCnt = UBound(arrDteClr(), 1)) Then ' ....but... Possible futher checks for not adjusting Normal Total Hrs to overtime and remove normal Hrs
580 'It is possible to check for absent before and after current day
590 If arrTotHrs(ShtCnt - 1, 1) = Empty And arrTotHrs(ShtCnt + 1, 1) = Empty Then '...."...holiday is deducted if the person does not come the day before and after the holiday...".... To facilitate this "ABSENT" is written in column K so that 30 - CountIf ABSENT will "remove a Holiday pay"
600 Let ValidHoliday = False
610 Else
620 Let ValidHoliday = True
630 End If
640 Else 'It is not possible for absence before AND after to check for absence as one will lie in last or next month
650 End If ' We remmain at default or last set true or just set true or false
660 'We had Holiday ...
670 If ValidHoliday = True Then ' ...and all conditions for valid Holiday pay adjustments
680 'Conditions met to adjust make all of 1 less of Normal Hrs to overtime
690 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
700 Let arrInOver(ShtCnt, 1) = arrTotHrs(ShtCnt, 1) ' Given To ' Added to arrInOver(ShtCnt, 1) + arrTotHrs(ShtCnt, 1)
710 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
720 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
730 End If
740 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"
750 Let arrL(ShtCnt, 1) = "H" ' ' (iv)H '_-Give string, "" value of H for valid Holiday in Admin's help column
760 Else ' We had a Holiday but abscence before and after, we make in this case the AbsentK column ABSENT
770 Let arrAbscentK(ShtCnt, 1) = "ABSENT" '_- This is unusual "Abscent" case. If after and before the Holiday, the employee is absent, then the Holiday is "marked" ( in column K ) as ABSENT. This
780 Let ValidHoliday = True 'we need to reset to true
790 End If
800 Else ' No Holy Holiday
810 Let arrL(ShtCnt, 1) = "N" ' give string N for normal ' (iv)N '_-Give string, "" value of N for normal Day
820 End If
830 If arrTotHrs(ShtCnt, 1) = Empty And Not arrDteClr(ShtCnt, 1) = 65535 Then Let arrAbscentK(ShtCnt, 1) = "ABSENT" '_- column K absent days should be marked as ABSENT. This is normal Absent case for normal workdays when employee is abscent
840 '3e) ' from last code, is not now used to calculate totals
850 Next ShtCnt '--------------------------End Inner loop for rows-----
860 '3f) Paste out final Totals and days to current Worksheet
870 Let wsStear.Range("G34").Value = "=SUMIF(L1:L" & lr & ",""N"",J1:J" & lr & ")*24"
880 Let wsStear.Range("J34").Value = "=SUMIF(L1:L" & lr & ",""H"",J1:J" & lr & ")*24"
890 Let wsStear.Range("C34").Value = "=30-COUNTIF(K1:K" & lr & ",""ABSENT"")"
900 '3g) Normal Hrs ( Column I ) and Overtime Hrs ( Column J ) are changed ' And can paste out help column if you like
910 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
920 Let FstDtaCel.Offset(0, 8).Resize(lr, 1).Value2 = arrInNorm() ' I
930 Let FstDtaCel.Offset(0, 11).Resize(lr, 1).Value2 = arrL() ' L
940 Let FstDtaCel.Offset(0, 10).Resize(lr, 1).Value2 = arrAbscentK() ' K
950 '3h) Set Booleans for
960 Next Cnt '==End main Loop==============================================
End Sub
'970 '
'980 'Rem Ref: http://www.excelfox.com/forum/showthread.php/2138-Understanding-VBA-Range-Object-Properties-and-referring-to-ranges-and-spreadsheet-cells
'990 '
'1000
-
All Sub Folder and File List from VBA Recursion routine. Explanation and Method Comparisons
Codes required for contribution to , and to be referenced from, these Threads: http://www.excelfox.com/forum/showth...lder-Using-VBA
https://excel.tips.net/T008233_Findi...e_Desktop.html
http://www.excelfox.com/forum/showth...ll=1#post12095
Theses are
_ the main initial code , ( Sub ( ) ) , used in a two code solution "recursion type" solution for Looping through all Folders and Subfolders and Files , starting from an in initial Folder which is given in this code and passed to the second code,
_ a "recursion type" code. This code successively takes a Folder, looks into its subfolders, and then passes all the subfolders successively to "itself" and repeats the process of then looking into the Sub Folders, and then passes all the subfolders successively to "itself" and repeats the process of then looking into the Sub Folders, and then passes all the subfolders successively to "itself" and repeats the process of then looking into the Sub Folders,…. Etc…..
The codes are discussed in detail at that Thread , starting from this post:
Initial Code to call the recursion code given below
Code:
'====================================
' Dec 2017 For Python Comparison. Tutorial Post: excelforum: Tutorial Post: ExcelFox:
'http://excelpoweruser.blogspot.de/2012/04/looping-through-folders-and-files-in.html http://www.excelforum.com/excel-programming-vba-macros/1126751-get-value-function-loop-through-all-files-in-folder-and-its-subfolders.html#post4316662 http://www.excelfox.com/forum/f5/loop-through-files-in-a-folder-using-vba-1324/
Sub VBADoStuffInFoldersInFolderRecursion() 'Main routine to "Call" the first copy of the second routine, VBALoopThroughEachFolderAndItsFile(
Rem 1A) Some Worksheets and General Variables Info
Dim Ws As Worksheet '_-Dim: Prepares "Pointer" to a "Blue Print" (or Form, Questionaire 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 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. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post4411
Set Ws = ThisWorkbook.Worksheets.Item(1) 'Worksheets("EFFldr") 'CHANGE TO SUIT YOUR WORKSHEET '_- 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
Ws.Range("B3:F30").ClearContents ' This line only needed for demo code
Dim celTL As Range: Set celTL = Ws.Range("B3") 'Top left of where Listing should go
Rem 2A) Get Folder Info
Dim strWB As String ' "Pointer" to a "Blue Print" (or Form, Questionaire 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 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. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
Let strWB = ThisWorkbook.Path & "\" & "EileensFldr" ' 'CHANGE TO SUIT if you store the main Folder to be looked through somewhere other than in the same Folder as this workbook in which the codes are in
Rem 3A ) ' FileSystemObject Object
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") 'Late Binding
'Dim FSO As Scripting.FileSystemObject 'Early Binding alternative activate a reference to the Microsoft Scripting Runtime Library ( MSRL ) in the Tools References menu of VB Editor Options.
'Set FSO = New Scripting.FileSystemObject 'Create an Instance of the Class Scripting FileSystemObject
Dim myFolder As Object 'An Object from myFolder, can be an declared as Dim myFolder As Folder also for Early Binding
Set myFolder = FSO.GetFolder(strWB) 'Set the selected Folder to the Object Folder using this Method which takes as arbument the Full String Path
Rem 4A )
Dim rCnt As Long: Let rCnt = 1: Dim CopyNumber1 As Long: Let CopyNumber1 = 1 '"Run progressin ( "down vertical" ) axis ( Row count for output ), "Down Folder chain to the right", The Count of the Copy of the called Procedue, here set to 1 for the first called copy of the second routine, which is done from this Sub( ) . Any subsequent calls of further second routine copies will be made by the current copy as it "freezes" and sets of that next copy
celTL.Value = myFolder.Path: celTL.Offset(0, 1).Value = myFolder.Name: Ws.Columns("A:C").AutoFit 'First output Row
'( -- Rem 5A) )
Call LoopThroughEachFolderAndItsFile(myFolder, celTL, rCnt, CopyNumber1) 'Up until now we just got the initial Folder. Now we go to all sub folders then all subfolders then all subfolders.......
' let Application.ScreenUpdating = True ' If this had been set to False earlier towards the start, as is often done, then the code might run a bit quicker by virtue of not updating the worksheet everytime an entry is made, but it is not really nacerssary unless the number of Files and Folders is massive. Even then it is probably better not to do that so that in the case of an error one has an additional way in the worksheet to see where the code stopped / errored
MsgBox "All Excel Files processed", vbInformation
Ws.Columns("A:H").AutoFit
End Sub
'Rem 5A) --
_........
_._________________
Second code. Recursion routine
Code:
'Rem 5A) --
Sub VBALoopThroughEachFolderAndItsFile(ByVal fldFldr As Object, ByRef celTL As Range, ByRef rCnt As Long, ByVal CopyNumberFroNxtLvl As Long) 'In below function we have a nested loop to iterate each files also
Dim myFldrs As Object ''This is used continuously as the "steering" thing, that is to say each Sub Folder in Folder loops, in loops, in loops......etc ....can be Dim myFldrs As Folder for early bindingDim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
Dim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
Let CopyNumber = CopyNumberFroNxtLvl 'This variable is local to the current running or paused copy of this routine.
'5Ab) Doing stuff for current Folder
For Each myFldrs In fldFldr.SubFolders 'SubFolders collection used to get at all Sub Folders
''''''''Doing stuff for each Folder, .. in this example giving '_-
'_- its full path including name : and just Flder Name ' -- *
Let rCnt = rCnt + 1 + 1 ''At each folder we always move down a line, and a dd amm extra line as a space between Folders ( The indication of the "column" or "down" to the right comes from the Copy Number of the Sub Procedure
Let celTL.Cells(rCnt, 1).Value = myFldrs.Path: celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = myFldrs.Name ' -- * 'Print out current Folder Path and Name in next free row.
''''''''End doing stuff for each Folder
'5Ac) Doing stuff for current file.
Dim oFile As Object ' ... for early binding can Dim oFile As file
For Each oFile In myFldrs.Files 'Looking at all Files types initially '#####
''''''''Doing Stuff for Each File
' Dim Extension As String: Let Extension = Right(oFile.Name, (Len(oFile.Name) - (InStrRev(oFile.Name, ".")))) 'To get the bit just after the . dot. #####
' If Left(Extension, 3) = "xls" Then 'Check for your required File Type #####
Let rCnt = rCnt + 1
celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = oFile.Name ' Do your stuff here
' Dim wkb As Workbook
On Error GoTo ErrHdlr 'In case problem opening file for example
' Set wkb = Workbooks.Open(oFile)
' wkb.Close SaveChanges:=True
' Else 'Do not do stuff for a Bad Extension ' #####
' End If ' #####
''''''''End Doing Sttuff for Each File
NxtoFile: Next oFile ' Spring Point after error handler so as to go on to next File after the File action that errored
Call LoopThroughEachFolderAndItsFile(myFldrs, celTL, rCnt, CopyNumber + 1) 'This is an example of recursion. It is actually very simple once you understand it. But it is just incredibly difficult to put in words. It is basically a Procedure that keeps calling itself as much as necessary as it goes "along", "down", or "to the right" of the Path "roots". Every time it goes off calling itself VBA runs a copy of that Procedure. It "Stacks" all info carefully for each "Copy" Run and continues to do this "drilling" down as far as it must, in this case finding the Next Folder, and then the next Folder in that, then the next Folder in that, then the next Folder in that...I think you get the point! Each time VBA makes a copy of the Routine and you go into that. The calling Routine then "freezes at its current state and all variable keep there values. The "Frozen" Routine then re starts when the copy finishes
Next
Exit Sub 'Normal End for no Errors
Rem 6 ) Error handler section just put here for convenience
ErrHdlr: 'Hopefully we know why we are here, and after informing can continue ( to next file )
MsgBox prompt:="Error " & Err.Description & " with File " & oFile & ""
On Error GoTo -1 'This needs to be done to reset the VBA exceptional error state of being. Otherwise VBA "thinks" Errors are being handeled and will not respond again to the Error handler.
On Error GoTo 0 ' Swiches off the current error handler. I do not really need to do this. But it is good practice so the error handler is only in place at the point where i next am expecting an error
GoTo NxtoFile
End Sub
_..
( Codes are also in the first Worksheet Code module of this Workbook: ( '== ' Dec 2017 For Python Comparison. https://app.box.com/s/gfuintgifu1hgw5nap3jriz2x8mp911x ) )
-
Dumping Logs. Recurring Excample
Dumping Logs for support of this Thread Post:
http://www.excelfox.com/forum/showth...0476#post10476
Test Function used to produce the Log below
Code:
'Going a HoldYaBackCalledYaBackClapTrapRuc - Copy number_GlobinalCntChopsLog - a few copies of this are made and run. (Recursion)
'_-=Rem 4===================??? Got me hook lochprocedue in my code , 5 times simple run then another + 29 new copies of it are run = 5+30=35 times in total calling it it a few times http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421 .... wanking myself up and down a few times
Private Function HoldYaBackCalledYaBackClapTrapRuc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' ByVal CopyNumberFroNxtLvl As Long) As Long
Let GlobinalCntChopsLog = GlobinalCntChopsLog + 1: Debug.Print " Going a HoldYaBackCalledYaBackClapTrapRuc"; GlobinalCntChopsLog; "(1Msg"; lMsg; ", wParam"; wParam; ", lParam"; lParam; ") Function Copy Number_"; GlobinalCntChopsLog
'If GlobinalCntChopsLog = 2 Then Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1: UnHookWindowsHookCodEx hHookTrapCrapNumber: Exit Function
If lMsg = 5 Then '_-.... ( Hook type: HCBT_ACTIVATE = 5 but not here?) ... this runs a further 29 copies of HoldYaBackCalledYaBackClapTrap all coming here, so 30 times in total
Debug.Print "Expose Interface"; Tab(30); GlobinalCntChopsLog
SetWindowPosition wParam, 0, poX, pussY, 400, 150, 40 ' SWP_NOZORDER is 4 .. but not here?? 'SWP_NOSIZE + SWP_NOZORDER ' Pull the Chainge position ...
UnHookWindowsHookCodEx hHookTrapCrapNumber ' Release the Hook 30 times this is done
Else
Debug.Print "No InterOfCourse"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
End If ' 5 times here then '_-....
Debug.Print "Wipe chain WRap"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
Let HoldYaBackCalledYaBackClapTrapRuc = 0 ' Done 5+30=35 times in total '0 (or False) makes it work, all other numbers and I get no Message box
Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1
End Function ' HoldYaBackCalledYaBackClapTrapRuc
Code:
---------------------------
MutsNuts AkaApi working ApplicationPromptToRangeInputBox
---------------------------
Select Range
---------------------------
OK
---------------------------
WndNumber 66770 HandleWndOfMyParent 983700 hWndDskTop 66204 hHookTrapCrapNumber
State of Much Such Penialtration's Number HookCodeXcretion's
================== AliAs Pull of my chain AliAs my long Hook
0
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 3 , wParam 2623104 , lParam 2353392 ) Function Copy Number_ 1
No InterOfCourse 1 276039693
Wipe chain WRap 1 276039693
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 3 , wParam 1377832 , lParam 2353500 ) Function Copy Number_ 1
No InterOfCourse 1 276039693
Wipe chain WRap 1 276039693
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 3 , wParam 3934358 , lParam 2353500 ) Function Copy Number_ 1
No InterOfCourse 1 276039693
Wipe chain WRap 1 276039693
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 3 , wParam 984706 , lParam 2353480 ) Function Copy Number_ 1
No InterOfCourse 1 276039693
Wipe chain WRap 1 276039693
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 9 , wParam 3934358 , lParam 66766 ) Function Copy Number_ 1
No InterOfCourse 1 276039693
Wipe chain WRap 1 276039693
Going a HoldYaBackCalledYaBackClapTrapRuc 1 (1Msg 5 , wParam 2623104 , lParam 2353812 ) Function Copy Number_ 1
Expose Interface 1
Going a HoldYaBackCalledYaBackClapTrapRuc 2 (1Msg 5 , wParam 2623104 , lParam 2353500 ) Function Copy Number_ 2
Expose Interface 2
Going a HoldYaBackCalledYaBackClapTrapRuc 3 (1Msg 5 , wParam 2623104 , lParam 2353188 ) Function Copy Number_ 3
Expose Interface 3
Going a HoldYaBackCalledYaBackClapTrapRuc 4 (1Msg 5 , wParam 2623104 , lParam 2352876 ) Function Copy Number_ 4
Expose Interface 4
Going a HoldYaBackCalledYaBackClapTrapRuc 5 (1Msg 5 , wParam 2623104 , lParam 2352564 ) Function Copy Number_ 5
Expose Interface 5
Going a HoldYaBackCalledYaBackClapTrapRuc 6 (1Msg 5 , wParam 2623104 , lParam 2352252 ) Function Copy Number_ 6
Expose Interface 6
Going a HoldYaBackCalledYaBackClapTrapRuc 7 (1Msg 5 , wParam 2623104 , lParam 2351940 ) Function Copy Number_ 7
Expose Interface 7
Going a HoldYaBackCalledYaBackClapTrapRuc 8 (1Msg 5 , wParam 2623104 , lParam 2351628 ) Function Copy Number_ 8
Expose Interface 8
Going a HoldYaBackCalledYaBackClapTrapRuc 9 (1Msg 5 , wParam 2623104 , lParam 2351316 ) Function Copy Number_ 9
Expose Interface 9
Going a HoldYaBackCalledYaBackClapTrapRuc 10 (1Msg 5 , wParam 2623104 , lParam 2351004 ) Function Copy Number_ 10
Expose Interface 10
Going a HoldYaBackCalledYaBackClapTrapRuc 11 (1Msg 5 , wParam 2623104 , lParam 2350692 ) Function Copy Number_ 11
Expose Interface 11
Going a HoldYaBackCalledYaBackClapTrapRuc 12 (1Msg 5 , wParam 2623104 , lParam 2350380 ) Function Copy Number_ 12
Expose Interface 12
Going a HoldYaBackCalledYaBackClapTrapRuc 13 (1Msg 5 , wParam 2623104 , lParam 2350068 ) Function Copy Number_ 13
Expose Interface 13
Going a HoldYaBackCalledYaBackClapTrapRuc 14 (1Msg 5 , wParam 2623104 , lParam 2349756 ) Function Copy Number_ 14
Expose Interface 14
Going a HoldYaBackCalledYaBackClapTrapRuc 15 (1Msg 5 , wParam 2623104 , lParam 2349444 ) Function Copy Number_ 15
Expose Interface 15
Going a HoldYaBackCalledYaBackClapTrapRuc 16 (1Msg 5 , wParam 2623104 , lParam 2349132 ) Function Copy Number_ 16
Expose Interface 16
Going a HoldYaBackCalledYaBackClapTrapRuc 17 (1Msg 5 , wParam 2623104 , lParam 2348820 ) Function Copy Number_ 17
Expose Interface 17
Going a HoldYaBackCalledYaBackClapTrapRuc 18 (1Msg 5 , wParam 2623104 , lParam 2348508 ) Function Copy Number_ 18
Expose Interface 18
Going a HoldYaBackCalledYaBackClapTrapRuc 19 (1Msg 5 , wParam 2623104 , lParam 2348196 ) Function Copy Number_ 19
Expose Interface 19
Going a HoldYaBackCalledYaBackClapTrapRuc 20 (1Msg 5 , wParam 2623104 , lParam 2347884 ) Function Copy Number_ 20
Expose Interface 20
Going a HoldYaBackCalledYaBackClapTrapRuc 21 (1Msg 5 , wParam 2623104 , lParam 2347572 ) Function Copy Number_ 21
Expose Interface 21
Going a HoldYaBackCalledYaBackClapTrapRuc 22 (1Msg 5 , wParam 2623104 , lParam 2347260 ) Function Copy Number_ 22
Expose Interface 22
Going a HoldYaBackCalledYaBackClapTrapRuc 23 (1Msg 5 , wParam 2623104 , lParam 2346948 ) Function Copy Number_ 23
Expose Interface 23
Going a HoldYaBackCalledYaBackClapTrapRuc 24 (1Msg 5 , wParam 2623104 , lParam 2346636 ) Function Copy Number_ 24
Expose Interface 24
Going a HoldYaBackCalledYaBackClapTrapRuc 25 (1Msg 5 , wParam 2623104 , lParam 2346324 ) Function Copy Number_ 25
Expose Interface 25
Going a HoldYaBackCalledYaBackClapTrapRuc 26 (1Msg 5 , wParam 2623104 , lParam 2346012 ) Function Copy Number_ 26
Expose Interface 26
Going a HoldYaBackCalledYaBackClapTrapRuc 27 (1Msg 5 , wParam 2623104 , lParam 2345700 ) Function Copy Number_ 27
Expose Interface 27
Going a HoldYaBackCalledYaBackClapTrapRuc 28 (1Msg 5 , wParam 2623104 , lParam 2345388 ) Function Copy Number_ 28
Expose Interface 28
Going a HoldYaBackCalledYaBackClapTrapRuc 29 (1Msg 5 , wParam 2623104 , lParam 2345076 ) Function Copy Number_ 29
Expose Interface 29
Going a HoldYaBackCalledYaBackClapTrapRuc 30 (1Msg 5 , wParam 2623104 , lParam 2344764 ) Function Copy Number_ 30
Expose Interface 30
Wipe chain WRap 30 276039693
Wipe chain WRap 29 276039693
Wipe chain WRap 28 276039693
Wipe chain WRap 27 276039693
Wipe chain WRap 26 276039693
Wipe chain WRap 25 276039693
Wipe chain WRap 24 276039693
Wipe chain WRap 23 276039693
Wipe chain WRap 22 276039693
Wipe chain WRap 21 276039693
Wipe chain WRap 20 276039693
Wipe chain WRap 19 276039693
Wipe chain WRap 18 276039693
Wipe chain WRap 17 276039693
Wipe chain WRap 16 276039693
Wipe chain WRap 15 276039693
Wipe chain WRap 14 276039693
Wipe chain WRap 13 276039693
Wipe chain WRap 12 276039693
Wipe chain WRap 11 276039693
Wipe chain WRap 10 276039693
Wipe chain WRap 9 276039693
Wipe chain WRap 8 276039693
Wipe chain WRap 7 276039693
Wipe chain WRap 6 276039693
Wipe chain WRap 5 276039693
Wipe chain WRap 4 276039693
Wipe chain WRap 3 276039693
Wipe chain WRap 2 276039693
Wipe chain WRap 1 276039693
_-.__________________________________
Windows Handleing Info:
Code:
' 1b) To hang in the Excel Window malking it effectively a Excel Msgbox... Normally if I did not do this ... don't do this .. that is to say leave it at 0 , specifically no window is 0 , and it "hanging in mid air so isn't even if it is imaginatively speaking
Public Declare Function FindWndNumber Lib "user32" Alias "FindWindowA" (Optional ByVal lpClassName As String, Optional ByVal lpWindowName As String) As Long
Dim HandleWndOfMyParent As Long ' I wanted to comment this 1b)(i) and ( 1b(ii) later ) out to leave it hanging in mid air in a virtual inadvirtual not thereness ... but somehow this complicated hook stuff does hang it somwhere but not in my Excel Window but I don't know what my parent's fart has to do with anything
' 1d) For some Misc experiments
Private Declare Function FindWindowExtremeNutty Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Dim WndNumber As Long, hWndDskTop As Long
Code:
Sub AkaApiApplicationPromptToRangeInputBox() ' This one works.. but HTF
' 1b(ii) This section is some how over written in / by the section part or some strange Addressing of HoldYaBackCalledYaBackClapTrap
Let WndNumber = FindWndNumber(lpClassName:=vbNullString, lpWindowName:=vbNullString)
Let HandleWndOfMyParent = FindWndNumber(lpClassName:="XLMAIN", lpWindowName:=vbNullString) ' This is a case where vbNullstring is important - that signifies that I am not giving it, which i do not have to. The second option is a bit flaky and does not often work. it certainly won't work if you make it "" as that is a specific string of zero. Null is a special idea in computing of not set yet / not defined - that is required if I do not want to give it
' 1d) Just some experiments, I forgot why as my brain has goine comfortably numb
Dim HeavyWindBreak As Long: Let HeavyWindBreak = HandleWndOfMyParent
Let hWndDskTop = FindWindowExtremeNutty(HandleWndOfMyParent, 0&, "XLDESK", vbNullString)
Debug.Print "WndNumber"; WndNumber; " HandleWndOfMyParent"; HandleWndOfMyParent; " hWndDskTop"; hWndDskTop; " hHookTrapCrapNumber"
Rem 3 Mess with me hook? God knows what this all does and it seems to make no difference if the proXYs poX or pussY are before or after SetWindowsHooksExample
-
Per PM request: One full working example of above code:
Code:
Option Explicit
Rem 1 ' This I understand. it is a simple more basic version of the VBA Message Box Function http://www.eileenslounge.com/viewtopic.php?f=18&t=28885#p223629
' 1a) UnWRap it and..
Private Declare Function APIssinUserDLL_MsgBox Lib "user32" Alias "MessageBoxA" (Optional ByVal HowManyFartsCanYouHandle As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
' 1b) To hang in the Excel Window malking it effectively a Excel Msgbox... Normally if I did not do this ... don't do this .. that is to say leave it at 0 , specifically no window is 0 , and it "hanging in mid air so isn't even if it is imaginatively speaking
Public Declare Function FindWndNumber Lib "user32" Alias "FindWindowA" (Optional ByVal lpClassName As String, Optional ByVal lpWindowName As String) As Long
Dim HandleWndOfMyParent As Long ' I wanted to comment this 1b)(i) and ( 1b(ii) later ) out to leave it hanging in mid air in a virtual inadvirtual not thereness ... but somehow this complicated hook stuff does hang it somwhere but not in my Excel Window but I don't know what my parent's fart has to do with anything
' 1d) For some Misc experiments
Private Declare Function FindWindowExtremeNutty Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Dim WndNumber As Long, hWndDskTop As Long
Dim Booloks As Boolean
'_-_._______________________________________________-
'_-=================??? main Declarations that I don't really understand
Rem 2 Position my box --- From here on I do not really have a clue
' 2(a) This will tie something on the chain for when you pull it https://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx
Private Declare Function SetWindowsHooksExample Lib "user32" Alias "SetWindowsHookExA" (ByVal Hooktype As Long, ByVal lokprocedureAddress As Long, Optional ByVal hmod As Long, Optional ByVal dwThreadId As Long) As Long
' 2(b) Wipe the chain clean
Private Declare Function UnHookWindowsHookCodEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHookTrapCrapNumber As Long) As Long
' 2(c) Don't loose the Thread? - This seems to have no effect , - maybe it would if something else was going on at the time. You don't want to loose the Thread I guess
'Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long ' Effectively long Null acttuall not ?? -
Public Declare Function GetCurrentFredId Lib "kernel32" Alias "GetCurrentThreadId" () As Long ' Effectively long Null acttuall not ?? -
' 2(d) This looks understandable almost, z(0 for top), posLeft, posTop, x pixels, y pixels,
Private Declare Function SetWindowPosition Lib "user32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal zNumber As Long, ByVal CoedX As Long, ByVal CoedY As Long, ByVal xPiXel As Long, ByVal yPiYel As Long, ByVal wFlags As Long) As Long
' 2e)
Private hHookTrapCrapNumber As Long ' Handle to the Hook procedure
' 2f)
Private poX As Long: Private pussY As Long ' Positional By proXYs
Dim GlobinalCntChopsLog As Long ' Only used in this test code to keep track of the copies of a Function(HoldYaBackCalledYaBackClapTrap) used in a recursion process
' 2g) bits to do with 1 that i am resonably happy with
Sub AkaApiApplicationPromptToRangeInputBox() ' This one works.. but HTF
' 1b(ii) This section is some how over written in / by the section part or some strange Addressing of HoldYaBackCalledYaBackClapTrap
Let WndNumber = FindWndNumber(lpClassName:=vbNullString, lpWindowName:=vbNullString)
Let HandleWndOfMyParent = FindWndNumber(lpClassName:="XLMAIN", lpWindowName:=vbNullString) ' This is a case where vbNullstring is important - that signifies that I am not giving it, which i do not have to. The second option is a bit flaky and does not often work. it certainly won't work if you make it "" as that is a specific string of zero. Null is a special idea in computing of not set yet / not defined - that is required if I do not want to give it
' 1d) Just some experiments, I forgot why as my brain has goine comfortably numb
Dim HeavyWindBreak As Long: Let HeavyWindBreak = HandleWndOfMyParent
Let hWndDskTop = FindWindowExtremeNutty(HandleWndOfMyParent, 0&, "XLDESK", vbNullString)
Debug.Print "WndNumber"; WndNumber; " HandleWndOfMyParent"; HandleWndOfMyParent; " hWndDskTop"; hWndDskTop; " hHookTrapCrapNumber"
Rem 3 Mess with me hook? God knows what this all does and it seems to make no difference if the proXYs poX or pussY are before or after SetWindowsHooksExample
Debug.Print "State of Much Such"; Tab(20); "Penialtration's Number"; Tab(45); "HookCodeXcretion's"
Debug.Print "=================="; Tab(20); "AliAs Pull of my chain"; Tab(45); "AliAs my long Hook"
Let GlobinalCntChopsLog = 0:
'_-======================== Weird thing with an AddressOf ???
Let poX = 10: pussY = 50 ' These can go before or after the next line, makes no diffference.. - I bet no Pro noticed that...
'Let hHookTrapCrapNumber = SetWindowsHooksExample(5, AddressOf HoldYaBackCalledYaBackClapTrap, 0, GetCurrentThreadId) ' (5-pull before flush, somehow arranges that the function gets called ,
Debug.Print ; Tab(75); hHookTrapCrapNumber ' 'APIssinUserDLL_MsgBox HeavyWindBreak, "Excel MsgBox", "This is Center Position", vbOKOnly ' This breaks Wnd in Excel Window
Call HookAPIssinUserDLL_MsgBoxThenDropIt
'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
'HookAPIssinUserDLL_MsgBoxThenDropIt
Dim Rng As Range: Set Rng = Selection
' (Optional ByVal hwnd As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
End Sub ' AkaApiApplicationPromptToRangeInputBox
Sub HookAPIssinUserDLL_MsgBoxThenDropIt()
Code:
Sub HookAPIssinUserDLL_MsgBoxThenDropIt()
' a) HOOK Hook the pseudo Windows Sub Class Function WinSubWinCls_JerkBackOffHooKerd
Dim BookMarkClassTeachMeWind As Long: Let BookMarkClassTeachMeWind = 5
'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTraped, 0, GetCurrentThreadId) ' (5-pull before flush, somehow arranges that the function gets called ,
'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentThreadId) ' (5-pull before flush, somehow arranges that the function gets called ,
Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentFredId) ' (5-pull before flush, somehow arranges that the function gets called ,
' b) Call the MessageBoxA
APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
End Sub
'_-=Rem 4===================??? Got me hook lochprocedue in my code , 5 times simple run then another + 29 new copies of it are run = 6+29=35 times in total calling it it a few times http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421 .... wanking myself up and down a few times
Code:
'_-=Rem 4===================??? Got me hook lochprocedue in my code , 5 times simple run then another + 29 new copies of it are run = 5+30=35 times in total calling it it a few times http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421 .... wanking myself up and down a few times
Private Function HoldYaBackCalledYaBackClapTrapRuc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' ByVal CopyNumberFroNxtLvl As Long) As Long
Let GlobinalCntChopsLog = GlobinalCntChopsLog + 1: Debug.Print " Going a HoldYaBackCalledYaBackClapTrapRuc"; GlobinalCntChopsLog; "(1Msg"; lMsg; ", wParam"; wParam; ", lParam"; lParam; ") Function Copy Number_"; GlobinalCntChopsLog
'If GlobinalCntChopsLog = 2 Then Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1: UnHookWindowsHookCodEx hHookTrapCrapNumber: Exit Function
If lMsg = 5 Then '_-.... ( Hook type: HCBT_ACTIVATE = 5 but not here?) ... this runs a further 29 copies of HoldYaBackCalledYaBackClapTrap all coming here, so 30 times in total
Debug.Print "Expose Interface"; Tab(30); GlobinalCntChopsLog
Call SetWindowPosition(wParam, 0, poX, pussY, 400, 150, 40) ' SWP_NOZORDER is 4 .. but not here?? 'SWP_NOSIZE + SWP_NOZORDER ' Pull the Chainge position ...
UnHookWindowsHookCodEx hHookTrapCrapNumber ' Release the Hook 30 times this is done
Else
Debug.Print "No InterOfCourse"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
End If ' 5 times here then '_-....
Debug.Print "Wipe chain WRap"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
Let HoldYaBackCalledYaBackClapTrapRuc = 0 ' Done 5+30=35 times in total '0 (or False) makes it work, all other numbers and I get no Message box
Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1
End Function ' HoldYaBackCalledYaBackClapTrapRuc
-
complete-page-numbers elided to non elided wonkie poos
Code solution for this Thread
http://www.excelfox.com/forum/showth...e-page-numbers
https://www.excelforum.com/excel-pro...d-numbers.html
Code:
Option Explicit
Sub Moshe() ' http://www.excelfox.com/forum/showthread.php/2229-complete-page-numbers
Rem 1 Make array for holding inoput data and output data - ' Input data can be handled as simple text so Array work is satisfactory
Dim arrIn() As Variant ' We know the data type can be taken as string, but I want to get the data quickly in a spreadsheet "capture" type way, using the .Value Property applied to a range object which returns a field of values for more than 1 cell returns a field of values held in Variant types, - so the type must be variant or a type mismatch runtime error will occcur
Let arrIn() = Range("A1:A" & Range("A1").CurrentRegion.Rows.Count & "").Value
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrIn())) ' I can use string type to suit my final data. I also know the array size, but I must make the array a dynamic ( unknown size ) type as the Dim declare statement will only take actual numbers, but I determine my size from the size of the input array by UBound(arrIn()) : the ReDim method will accept the UBound(arrIn()) , wheras the Dim declaration syntax will not accept this, as the Dim is done at complie and not runtime
Rem 2 Effectively looping for each data row
Dim Cnt As Long ' For going through each "row"
For Cnt = 1 To UBound(arrIn()) ' Going through each element in arrIn()
'2a) split the data in a cell into an array of data. The VBA strings collection split function will return a 1 dimentsional array of string types starting at indicie 0
Dim spltEnt() As String ' For the string row split into each number entry, in other words an array of the data in a cell
If InStr(1, arrIn(Cnt, 1), ", ", vbBinaryCompare) <> 0 Then ' case more than 1 entry in cell. starting at the first character , in the current Cnt array element , I look for ", " , stipulating an excact computer match search type This Function will return eitheer the position counting from the left that it finds the first ", " or it will return 0 if it does not find at least one occurance of the ", "
Let spltEnt() = VBA.Strings.Split(arrIn(Cnt, 1), ", ", -1, vbBinaryCompare) ' we now have a number or number pair
Else ' case a single entry I cannot split by a ", " as i don't have any, ...
ReDim spltEnt(0): Let spltEnt(0) = arrIn(Cnt, 1) ' ... so i just make a single element array and put the single element in it
End If
'2b) working through each data part in a cell
Dim strOut As String 'String in each "row" '_-"Pointer" to a "Blue Print" (or Form, Questionaire 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 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. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
Dim CntX 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
For CntX = 0 To UBound(spltEnt()) ' for going through each entry in a row in other words for going through each piece of data in a cell
'2c)(i) case just data for a single page
If InStr(1, spltEnt(CntX), "-", vbBinaryCompare) = 0 Then ' case of no "-"
Let strOut = strOut & spltEnt(CntX) & ", " ' just the single number goes in the output string, strOut
Else ' we have a "-"
Dim NmbrPear() As String ' this will be am Array of 2 elements for each number pair
Let NmbrPear() = VBA.Strings.Split(spltEnt(CntX), "-", -1, vbBinaryCompare)
'2c)(ii) case no correction needed in the data
If Len(NmbrPear(0)) = Len(NmbrPear(1)) Then ' the numbers are the same
Let strOut = strOut & spltEnt(CntX) & ", " ' the same number pair goes in the output string
Else ' from here on, we need to do some adjustment before adding to the output string
'2c)(iii) cases data correction needed
Select Case Len(NmbrPear(0)) - Len(NmbrPear(1)) ' selecting the case of the difference in length of the two parts of the data "FirstNumberPart-SecondNumberPart"
Case 1 ' Like 123-24 or 12345-2345
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 1) & NmbrPear(1) ' like 1 & 24 or 1 & 2345 ' VBA strings collection Mid Function: This returns the part of ( NmbrPear(0) , the starts at character 1 , and has the length of 1 character )
Case 2 ' like 123-4
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 2) & NmbrPear(1) ' like 12 & 4
Case 3 ' like 1234-6
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 3) & NmbrPear(1) ' like 123 & 6
Case 3 ' like 12345-8
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 4) & NmbrPear(1) ' like 1234 & 8
End Select ' at this point we have corrected our second number part from the pair
Let strOut = strOut & VBA.Strings.Join(NmbrPear(), "-") & ", " ' The number pair is rejoined with the corrected second number part before adding the number parts pair to the output string
End If
End If
Next CntX
'2d) The string of corrected data can now be added to the array for output
Let strOut = VBA.Strings.Left$(strOut, Len(strOut) - 2) ' This removes the last unwanted ", " ' 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm - bit iffy although you could argue that Null has not been entered yet.. may never
Let arrOut(Cnt) = strOut ' Finally the string is aded to the current "row" in the outout array
Let strOut = "" ' Empty variable holding a row string for use ijn next loop
Next Cnt
Rem 3 I have the final data array, and so umst now paste it out where I want it.
Dim arrClmOut() As String: ReDim arrClmOut(1 To UBound(arrOut), 1 To 1) ' This is for a 1 column 2 Dimensional array which I need for the orientation of my final output
'3(i) a simple loop to fill the transposed array
Dim rCnt As Long '
For rCnt = 1 To UBound(arrOut())
Let arrClmOut(rCnt, 1) = arrOut(rCnt)
Next rCnt
'3(ii) Output to worksheet
Let Range("B1").Resize(UBound(arrOut())).Value = arrClmOut() ' The cell Top left of where the output should go is resized to the required row size, and 1 column. The .Value Property of that range object may have the values in an Array assigned to it in a simpla one line assignment
End Sub
'
'
'
' http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
' https://www.excelforum.com/word-programming-vba-macros/1175184-vba-word-repeat-character-in-string-a-number-of-times.html#post4591171
-
Function CStrSepDbl Excel VBA comma point thousand decimal separator number problem
Code for this Thread:
http://www.excelfox.com/forum/showth...0503#post10503
http://www.excelfox.com/forum/forumd...ips-and-Tricks
Function CStrSepDbl
Code:
'10 ' http://www.eileenslounge.com/viewtopic.php?f=27&t=22850#p208624
Function CStrSepDbl(Optional ByVal strNumber As String) As Double ' Return a Double based on a String Input which is asssumed to "Look" like a Number. The code will work for Leading and Trailing zeros, but will not return them. )
20 Rem 0 At the Dim stage a '_-String is "Pointer" to a "Blue Print" (or Form, Questionaire 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. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks, But http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
30 If StrPtr(strNumber) = 0 Then Let CStrSepDbl = "9999999999": Exit Function '_- StrPtr(MyVaraibleNotYetUsed)=0 .. http://www.excelfox.com/forum/showthread.php/1828-How-To-React-To-The-Cancel-Button-in-a-VB-(not-Application)-InputBox?p=10463#post10463 https://www.mrexcel.com/forum/excel-questions/35206-test-inputbox-cancel-2.html?highlight=strptr#post2845398 https://www.mrexcel.com/forum/excel-questions/917689-passing-array-class-byval-byref.html#post4412382
40 Rem 1 'Adding a leading zero if no number before a comma or point, change all seperators to comma ,
50 If VBA.Strings.Left$(strNumber, 1) = "," Or VBA.Strings.Left$(strNumber, 1) = "." Then Let strNumber = "0" & strNumber ' case for like .12 or ,7 etc 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm -bit iffy although you could argue that Null has not been entered yet..may never
60 If VBA.Strings.Left$(strNumber, 2) = "-," Or VBA.Strings.Left$(strNumber, 2) = "-." Then Let strNumber = Application.WorksheetFunction.Replace(strNumber, 1, 1, "-0") ' case for like -.12 or -,274 etc
70 Let strNumber = Replace(strNumber, ".", ",", 1, -1, vbBinaryCompare) 'Replace at start any . to a , After this point there should be either no or any amount of ,
80 'Check If a Seperator is present, then MAIN CODE is done
90 If InStr(1, strNumber, ",") > 0 Then 'Check we have at least one seperator, case we have, then..
100 Rem 2 'MAIN CODE part ====
110 'Length of String: Position of last ( Decimal ) Seperator
120 Dim LenstrNumber As Long: Let LenstrNumber = Len(strNumber): Dim posDecSep As Long: Let posDecSep = VBA.Strings.InStrRev(strNumber, ",", LenstrNumber) ' from right the positom "along" from left ( (in strNumber) , for a (",") , starting at the ( Last character ) which BTW. is the default
130 'Whole Number Part
140 Dim strHlNumber As String: Let strHlNumber = VBA.Strings.Left$(strNumber, (posDecSep - 1))
150 Let strHlNumber = Replace(strHlNumber, ",", Empty, 1, -1) 'In (strHlNumber) , I look for a (",") , and replace it with "VBA Nothing there" , considering and returning the strNumber from the start of the string , and replace all occurances ( -1 ).
160 Dim HlNumber As Long: Let HlNumber = CLng(strHlNumber) 'Long Number is a Whole Number, no fractional Part
170 'Fraction Part of Number
180 Dim strFrction As String: Let strFrction = VBA.Strings.Mid$(strNumber, (posDecSep + 1), (LenstrNumber - posDecSep)) 'Part of string (strNumber ) , starting from just after Decimal separator , and extending to a length of = ( the length of the whole strNumber minus the position of the separator )
190 Dim LenstrFrction As Long: Let LenstrFrction = Len(strFrction) 'Digits after Seperator. This must be done at the String Stage, as length of Long, Double etc will allways be 8, I think?.
200 Dim Frction As Double: Let Frction = CDbl(strFrction) 'This will convert to a Whole Double Number. Double Number can have Fractional part
210 Let Frction = Frction * 1 / (10 ^ (LenstrFrction)) 'Use 1/___, rather than a x 0.1 or 0,1 so as not to add another , . uncertainty!!
220 'Re join, using Maths to hopefully get correct Final Value
230 Dim DblReturn As Double 'Double Number to be returned in required Format after maniplulation.
240 If Left(strHlNumber, 1) <> "-" Then 'Case positive number
250 Let DblReturn = CDbl(HlNumber) + Frction 'Hopefully a simple Mathematics + will give the correct Double Number back
260 Else 'Case -ve Number
270 Let strHlNumber = Replace(strHlNumber, "-", "", 1, 1, vbBinaryCompare) ' strHlNumber * (-1) ' "Remove" -ve sign
280 Let DblReturn = (-1) * (CDbl(strHlNumber) + Frction) 'having constructed the value of the final Number we multiply by -1 to put the Minus sign back
290 End If 'End checking polarity.
300 'Final Code Line(s) At this point we have what we want. We need to place this in the "Double Type variable" , CStrSepDbl , so that an assinment like = CStrSepDbl( ) will return this final value
310 Let CStrSepDbl = DblReturn 'Final Double value to be returned by Function
320 Else 'End MAIN CODE. === We came here if we have a Whole Number with no seperator, case no seperator
330 'Simple conversion of a string "Number" with no Decimal Seperator to Double Format
340 Let CStrSepDbl = CDbl(strNumber) 'String to be returned by Function is here just a simple convert to Double ' I guess this will convert a zero length string "" to 0 also
350 End If 'End checking for if a Seperator is present.
End Function
'Long code lines: Referrences http://www.mrexcel.com/forum/about-board/830361-board-wish-list-2.html http://www.mrexcel.com/forum/test-here/928092-http://www.eileenslounge.com/viewtopic.php?f=27&t=22850
Function CStrSepDblshg(strNumber As String) As Double ' http://excelxor.com/2014/09/05/index-returning-an-array-of-values/ http://www.techonthenet.com/excel/formulas/split.php
5 If Left(strNumber, 1) = "," Or Left(strNumber, 1) = "." Then Let strNumber = "0" & strNumber
20 Let strNumber = Replace(strNumber, ".", ",", 1, -1)
40 If InStr(1, strNumber, ",") > 0 Then
170 If Left(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1), 1) <> "-" Then
180 Let CStrSepDblshg = CDbl(CLng(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1))) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber)))))))
190 Else
210 Let CStrSepDblshg = (-1) * (CDbl(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1) * (-1)) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))))))
220 End If
250 Else
270 Let CStrSepDblshg = CDbl(strNumber)
280 End If
End Function
Demo Code to call Function
Code:
Sub TestieCStrSepDbl() ' using adeptly named TabulatorSyncranartor ' / Introducing LSet TabulatorSyncranartor Statement : http://www.excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
Dim LooksLikeANumber(1 To 17) As String
Let LooksLikeANumber(1) = "001,456"
Let LooksLikeANumber(2) = "1.0007"
Let LooksLikeANumber(3) = "123,456.2"
Let LooksLikeANumber(4) = "0023.345,0"
Let LooksLikeANumber(5) = "-0023.345,0"
Let LooksLikeANumber(6) = "1.007"
Let LooksLikeANumber(7) = "1.3456"
Let LooksLikeANumber(8) = "1,2345"
Let LooksLikeANumber(9) = "01,0700000"
Let LooksLikeANumber(10) = "1.3456"
Let LooksLikeANumber(11) = "1,2345"
Let LooksLikeANumber(12) = ".2345"
Let LooksLikeANumber(13) = ",4567"
Let LooksLikeANumber(14) = "-,340"
Let LooksLikeANumber(15) = "00.04"
Let LooksLikeANumber(16) = "-0,56000000"
Let LooksLikeANumber(17) = "-,56000001"
Dim Stear As Variant, MyStringsOut As String
For Each Stear In LooksLikeANumber()
Dim Retn As Double
Let Retn = CStrSepDbl(Stear)
Dim TabulatorSyncranartor As String: Let TabulatorSyncranartor = " "
LSet TabulatorSyncranartor = Stear
Let MyStringsOut = MyStringsOut & TabulatorSyncranartor & Retn & vbCrLf
Debug.Print Stear; Tab(15); Retn
Next Stear
MsgBox MyStringsOut
End Sub
Code also Here:
https://pastebin.com/1kq6h9Bn
-
VBA to automate Send and Automatically Sending of E-Mails and Excel File Workbooks
Further notes in support of answer to this Thread:
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518
Microsoft Outlook.
WTF is that and HTF do you do anything with it, and WTF is it supposed to do.
I didn't know. And still don't......
The internet is full of stuff on this, but there is no clear explanation of what it is or what it should do or how you do anything with it.
But I had a go
Microsoft Outlook: what is that ( using manually )
You would normally get the software to run on its own ( visible as it were ) in a similar way to which you might get Word or Excel to start, for example
Find it single click on it:
FindOutlook Start AllProgrammes Microsoft MicrosoftOutlook.JPG : https://imgur.com/LaGs6HA
FindOutlook Start TypeInSearchBox Outlook.JPG : https://imgur.com/IbFOSHz
Make a Desktop icon from a Copy/ paste and double click on it :
MicrosoftOutlook Make a desktop Icon to double click on.JPG : https://imgur.com/ZNNPmOI
The first time you try to open it with a click or two, a set up starts.
Outlook2003Start.JPG https://imgur.com/tSQDoTe
The main use of the Outlook software is to do Email stuff, so usually you will have at least one Email account “registered in it” You can do this at the set up or later.
I had a go,
the start was OK:
Outlook2003Start.JPG https://imgur.com/R71pKfy
Outlook2003Start2.JPG https://imgur.com/XUFMpEm
These following steps took me a few hours of Emails, Internet surfing and annoying Telephone calls to my Internet provider before I
_ chose IMAP here : Outlook2003Start3ServerType.JPG : https://imgur.com/Jmnd6Vb
and
_ got the two required things to put in the 2 server information bars, and other stuff to fill in this : Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J
Code:
Von: "Doc.AElstein@t-online.de" <Doc.AElstein@t-online.de>
An: "elston, alan" <Doc.AElstein@t-online.de>
Pop3
* Serveradresse Port* Sicherheit
Posteingang securepop.t-online.de 995 SSL / TLS
Postausgang securesmtp.t-online.de 465 SSL
*
E-Mails über IMAP4 abrufen
* Serveradresse Port* Sicherheit
Posteingang secureimap.t-online.de 993 SSL
Postausgang securesmtp.t-online.de 465 SSL
From: "Doc.AElstein@t-online.de" <Doc.AElstein@t-online.de>
To: "elston, alan" <Doc.AElstein@t-online.de>
pop3
Server address Port Security
Inbox securepop.t-online.de 995 SSL / TLS
Outbox securesmtp.t-online.de 465 SSL
Retrieve emails via IMAP4
Server address Port Security
Inbox secureimap.t-online.de 993 SSL
Outbox securesmtp.t-online.de 465 SSL
Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J
MyTelekomNameUsernamePassword.JPG : https://imgur.com/K6qZgsE
TelekomInternetConfiguration.JPG : https://imgur.com/Z3XcsJu
Then I hit Finish:
Outlook2003Start5Fertig.JPG : https://imgur.com/wIMvqBb ´
I get an error in the left Pane atz that point or later as well sometimes :
Outlook2003Start6LeftpaneErrror.JPG : https://imgur.com/35XLQv6
Code:
could not connect to the server secureimap t online.JPG : https://imgur.com/UqEZtQe
Fehler (0x800CCC0E) beim Ausführen der Aufgabe "Suchen nach neuen Nachrichten in den abonnierten Ordnern auf secureimap.t-online.de.": "Der Download des Ordners "(null)" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."
Fehler (0x800CCC0E) beim Ausführen der Aufgabe "secureimap.t-online.de: Posteingang - Auf neue E-Mail überprüfen.": "Der Download des Ordners "Posteingang" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."
Error (0x800CCC0E) while performing the task "Search for new messages in the subscribed folders on secureimap.t-online.de.": "Downloading the folder" (null) "from account" secureimap.t-online.de "from IMAP mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "
Error (0x800CCC0E) when executing the task "secureimap.t-online.de: Inbox - Check for new e-mail.": "The download of the folder" Inbox "of account" secureimap.t-online.de "from IMAP- Mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "
Every time I open Microsoft Outlook after that I get a pop up : could not connect to the server secureimap t online.JPG : https://imgur.com/UqEZtQe
Code:
Es Konnte keine Verbindung zum Server hergestellt werden. secureimap.t-online.de befindet sich jetzt im Offlinemodus
It could not connect to the server. secureimap.t-online.de is now in offline mode
So I am still none the wiser, but It is worth doing all that anyway as you may need some of that information later in one or more of the ways to send an Email using VBA.
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=oVb1RfcSHLM&lc=UgwTq-jZlZLnLQ5VB8Z4AaABAg.9Hroz-OyWog9tYjSMc1qjA
https://www.youtube.com/watch?v=0pbsf6sox34&lc=Ugxp9JFvvejnqA68W1t4AaABAg
https://www.youtube.com/watch?v=kfQC-sQxMcw&lc=UgyCxQWypNIhG2nUn794AaABAg.9q1p6q7ah839t UQl_92mvg
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
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
VBA to automate Send and Automatically Sending of E-Mai
_1 ) Way 1) Use the CDO (Collaboration Data Objects ) object library available in VBA
Main Code , Sub PetrasDailyProWay1_COM_Way() ,
and
Function Code for solution to this Thread and Post
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518
Code:
Option Explicit ' Daily Diet plan, Sending of Notes and an Excel File
Sub PetrasDailyProWay1_COM_Way() ' Allow access to deep down cods wollops from Microsoft to collaborating in particular in the form of messaging. An available library of ddl library functions and associated things is available on request, the Microsoft CDO for Windows 2000. We require some of these ' CDO is an object library that exposes the interfaces of the Messaging Application Programming Interface (MAPI). API: interfaces that are fairly easy to use from a fairly higher level from within a higher level programming language. In other words this allows you to get at and use some of the stuff to do with the COM OLE Bollocks from within a programming language such as VBA API is often referring loosely to do with using certain shipped with Windows software in Folders often having the extension dll. This extension , or rather the dll stands for direct link libraries. These are special sort of executable files of functions shared by many other (Windows based usually) software’s.
' Rem1 The deep down fundamental stuff , which includes stuff been there the longest goes by the name of Component Object Model. Stuff which is often, but not always, later stuff, or at a slightly higher level of the computer workings, or slightly more to a specific application ( an actual running "runtime" usage / at an instance in time , "instance of" ) orientated goes to the name of Object Linking and Embedding. At this lower level, there are protocols for communicating between things, and things relate are grouped into the to Office application available Library, CDO. An important object there goes by the name of Message.
'Rem 1) Library made available ====================#
With CreateObject("CDO.Message") ' Folders mostly but not always are in some way referenced using dll, either as noted with the extension or maybe refered to as dll Files or dll API files.
'Rem 2 ' Intraction protocols are given requird infomation and then set
'2a) 'With --------------------* my Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) which are used and items configured for the Exchange at Microsoft’s protocol thereof; http://schemas.microsoft.com/cdo/configuration/ ......This section provides the configuration information for the remote SMTP server
Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" ' Linking Configuration Data : defines the majority of fields used to set configurations for various Linking Collaboration (LCD) Objects Cods Wollops: These configuration fields are set using an implementation of the IConfiguration.Fields collection. https://msdn.microsoft.com/en-us/library/ms872853(v=exchg.65).aspx
.Configuration(LCD_CW & "smtpusessl") = True ' ' ' HTTPS (Hyper Text Transfer Protocol Secure) appears in the URL when a website is secured by an SSL certificate. The details of the certificate, including the issuing authority and the corporate name of the website owner, can be viewed by clicking on the lock symbol on the browser bar. in short, it's the standard technology for keeping an internet connection secure and safeguarding any sensitive data that is being sent between two systems, preventing criminals from reading and modifying any information transferred, including potential personal details. ' SSL protocol has always been used to encrypt and secure transmitted data
.Configuration(LCD_CW & "smtpauthenticate") = 1 ' ... possibly this also needed .. When you also get the Authentication Required Error you can add this three lines.
' ' Sever info
.Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "securesmtp.t-online.de" '"smtp.gmail.com" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" 465 SMTP is just used to mean the common stuff..... Simple Mail Transport Protocol (SMTP) server is used to send outgoing e-mails. The SMTP server receives emails from your Mail program and sends them over the Internet to their destination.
' The mechanism to use to send messages.
.Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4
.Configuration(LCD_CW & "smtpserverport") = 25 ' 465or25fort-online ' 465 'or 587 'or 25 ' The port of type somehow refered to by the last line
'
.Configuration(LCD_CW & "sendusername") = "excelvbaexp@gmail.com" ' "Doc.AElstein@t-online.de" ' .... "server rejected your response". AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail .... Runtime error '-2147220975 (800440211)': The message could not be sent to the SMTP server. The transport error code is 0x80040217. The server response is not available
.Configuration(LCD_CW & "sendpassword") = "Bollocks" ' "Bollox"
' Optional - How long to try ( End remote SMTP server configuration section )
.Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' Or there Abouts ;) :)
' Intraction protocol is Set/ Updated
.Configuration.Fields.Update ' 'Not all infomation is given, some will have defaults. - possibly this might be needed initially .. .Configuration.Load -1 ' CDO Source Defaults
'End With ' -------------------* my Created LCDCW Library ( Linking Configuration Data Cods Wollups) which are used and items configured for the Exchange at Microsoft's protocol therof;
'2b) ' Data to be sent
'.To = "Doc.AElstein@t-online.de"
.To = "excelvbaexp@gmail.com"
.CC = ""
.BCC = ""
.from = """Alan"" <Doc.AElstein@t-online.de>"
.Subject = "Bollox"
'.TextBody = "Hi" & vbNewLine & vbNewLine & "Please find the Excel workbook attached."
.HTMLBody = MyLengthyStreaming
.AddAttachment "G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\Übersicht aktuell.xlsx" ' ' Full File path and name. File must be closed
Rem 3 Do it
.Send
End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
End Sub
Public Function MyLengthyStreaming() As String
Rem 1 Make a long string from a Microsoft Word doc
'1(i) makes available the Library of stuff, objects, Methods etc.
Dim Fso As Object: Set Fso = CreateObject("Scripting.FileSystemObject")
'1(ii) makes the big File Object " Full path and file name of Word doc saved as .htm "
Dim FileObject As Object: Set FileObject = Fso.GetFile("G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\ProMessage.htm"): Debug.Print FileObject
'1(iii) sets up the data "stream highway"
Dim Textreme As Object: Set Textreme = FileObject.OpenAsTextStream(iomode:=1, Format:=-2) ' reading only, Opens using system default https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
'1(iv) pulls in the data, in our case into a simple string variable
Let MyLengthyStreaming = Textreme.ReadAll ' Let MyLengthyStreaming = Replace(MyLengthyStreaming, "align=center x:publishsource=", "align=left x:publishsource=")
Textreme.Close
Set Textreme = Nothing
Set Fso = Nothing
Rem 2 possible additions to MyLengthyStreaming
Last bit of Function ( must go here in the excelfox Test Sub Forum in HTML Tags as there are HTML Tags in the final text string string and this makes a mess in normal BB code tags, because in excelfox Test Forum HTML is activated ) :
HTML Code:
Rem 2
Let MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
End Function
-
5 Attachment(s)
Function Code for solution to this Thread and Post
http://www.excelfox.com/forum/showth...0518#post10518
HTML For CDO.Message.HTMLBody in VBA Emails sending
Linked in my Binding Function, MyLenghtyString LBF_MLS
In support of this Thread:
http://www.excelfox.com/forum/showth...kbooks-at-once
HTM / HTML is a very typical electronic message language recognised by most software devices associated with Email and similar.
In two ways considered in this Thread , http://www.excelfox.com/forum/showth...0512#post10512 , the main Message Text body to be sent in an Email can be supplied as a single HTML code string.
One convenient way to supply this is with a simple Word.doc file which can simply saved with a htm file extension
Word doc to htm.JPG : https://imgur.com/vhRE9CC
By opening this with a simple text editor, the actual text along with much more htm code detail can be revealed
LastBitOfProMessage htm.JPG : https://imgur.com/mT6l40I
LastBitOfProMessage htm 2.JPG : https://imgur.com/s0U8419
This is the actual text required to be given after the an Email data filling code line like:
_ .HTMLBody =
The actual file held anywhere will likely include all sorts of computery stuff in addition to that text.
We can get at just the text in several ways.
A typical way in VBA is to make use of one of a number of Object Orientated stuff held in the Visual Basic FileSystemObject Object. This is in turn part of the Bundle in the available to application programs (such as Excel VBA) Library, Microsoft Scripting Runtime
The way this works is as follows.
For a given file, a large object can be made within the Microsoft Scripting Runtime Library Class type Module like Library, ** Polymorphically speaking.
The Microsoft Scripting Runtime FileSystemObject Object GetFile method returns this object requiring only its full file path in order to “Get at it” . ( The returned object is pseudo in the streaming runtime instant direct compiling linking .Net technology held as a running link, ( indeed by assigning the object to, or using in an environment of, String will itself return that arguments string reference ) )
**:From Microsoft documentation: Visual Basic provides polymorphism through multiple ActiveX interfaces. In the Component Object Model (COM) that forms the infrastructure of the ActiveX specification, multiple interfaces allow systems of software components to evolve and break existing code.
In this sense interface is a set of related properties and methods. Much of the ActiveX specification is concerned with implementing standard interfaces to obtain system services or to provide malfunctionality to other programs.
The actual processes involved are in the meantime so messed up that it is a wonder that anything still works, and I doubt it will be long before nothing does.
The large FileObject in the Microsoft Scripting Runtime Library Class type Module like Library has information , amongst other things of neighbouring things , and as is typical in this mixed up messed up process , a short tem path or highway is made, and more often than not a “text stream object”, something like a continuous stream of data or like a highways going around in circles, and this will only be of a runtime existence, or at any rate should.. during this lifetime it can be “read”. I guess for any file of any type data within it will be recognised as such and can be handled in this simple text stream way.
The original coding goes quite a way back and does not really fit in Object Orientated Visual basic hierarchical structure of the original implementation of File I/O in Visual Basic. But it does at lest work well in getting at text stream string things which we are interested in
The available methods and the such reflect all the above…
-…So code will have a string getting section that..
1(i) makes available the Library of stuff, objects, Methods etc.
1(ii) makes the big File Object
1(iii) sets up the data “stream highway”
1(iv) pulls in the data, in our case into a simple string variable
_.____
I have decided for my requirement to use a “Function” for this, not just to house tidily the above steps, but also as I may add some additional bits from time to time too the main inner body string for my Email message, which the main function of this all is to produce.
To recap on the Function idea here ( http://www.excelfox.com/forum/showth...blem#post10503 )
In end effect I want a String. In fact in the main code in which this should be embedded has this as a variable
Pseudo, Linked in my Binding Function, ObjectLinkedEbeded Stuff
In place of an actual static linked variable_...
Dim MyLenghtyString As String
_ Let MyLenghtyString = “static linked at pseudo Compile String”
_.. I have
Function MyLenghyString(Export) As String
_ Pall MyLenghyString()_Import
_.. or Let MyLenghtyString = “direct linked runny runable library”
The end result is that in my code I will have simply pulling of
_ .HTMLBody = MyLengthyStreaming
Function Code description:
Rem 1
This uses the File System Object way discussed above to finally produce a long text string in variable _ MyLengthyStreaming _ This string probably has a of unnecessary stuff as well as the required part of the HTML code, but appears to be able to be handled and manipulated as if it were just the required part. Presumably the rest is ignored by things such as internet browsers
Rem 2
This allows for some extra simple string data to be added. If you are not familiar with HTML code then you can easily get the required string from text to HTML converters of which there are many freely available in internet
Note: If you have any “ in your required HTML string, then you will need to replace them in the given string in the VBA code with “”
http://www.excelfox.com/forum/showth...rmat#post10448
' https://support.microsoft.com/en-in/kb/186118
https://www.youtube.com/watch?v=nj8mU3ecwsM
https://www.youtube.com/watch?v=f8s-jY9y220&t=1813s
Note: ' path in code must be changed to reflect where you save .htm file
Pubic Function MyLengthyStreaming() As String
Code:
Public Function MyLengthyStreaming() As String
Rem 1 Make a long string from a Microsoft Word doc
'1(i) makes available the Library of stuff, objects, Methods etc.
Dim Fso As Object: Set Fso = CreateObject("Scripting.FileSystemObject")
'1(ii) makes the big File Object " Full path and file name of Word doc saved as .htm "
Dim FileObject As Object: Set FileObject = Fso.GetFile("G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\ProMessage.htm"): Debug.Print FileObject ' path in code must be changed to reflect where you save it
'1(iii) sets up the data "stream highway"
Dim Textreme As Object: Set Textreme = FileObject.OpenAsTextStream(iomode:=1, Format:=-2) ' reading only, Opens using system default https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
'1(iv) pulls in the data, in our case into a simple string variable
Let MyLengthyStreaming = Textreme.ReadAll ' Let MyLengthyStreaming = Replace(MyLengthyStreaming, "align=center x:publishsource=", "align=left x:publishsource=")
Textreme.Close
Set Textreme = Nothing
Set Fso = Nothing
Rem 2 possible additions to MyLengthyStreaming
HTML Code:
Rem 2
Let MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
End Function
MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
MyLengthyStreaming = "[color=Black]<[/color]p[color=Black]>[/color][color=Black]<[/color]span style=""color: #ff00ff;""[color=Black]>[/color]Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------[color=Black]<[/color]/span[color=Black]>[/color][color=Black]<[/color]/p[color=Black]>[/color]" & MyLengthyStreaming & "[color=Black]<[/color]p[color=Black]>[/color][color=Black]<[/color]span style=""color: #ff00ff;""[color=Black]>[/color]-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======[color=Black]<[/color]/span[color=Black]>[/color][color=Black]<[/color]/p[color=Black]>[/color]"
Code:
Public Function MyLengthyStreaming() As String
Rem 1 Make a long string from a Microsoft Word doc
'1(i) makes available the Library of stuff, objects, Methods etc.
Dim Fso As Object: Set Fso = CreateObject("Scripting.FileSystemObject")
'1(ii) makes the big File Object " Full path and file name of Word doc saved as .htm "
Dim FileObject As Object: Set FileObject = Fso.GetFile("G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\ProMessage.htm"): Debug.Print FileObject
'1(iii) sets up the data "stream highway"
Dim Textreme As Object: Set Textreme = FileObject.OpenAsTextStream(iomode:=1, Format:=-2) ' reading only, Opens using system default https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
'1(iv) pulls in the data, in our case into a simple string variable
Let MyLengthyStreaming = Textreme.ReadAll ' Let MyLengthyStreaming = Replace(MyLengthyStreaming, "align=center x:publishsource=", "align=left x:publishsource=")
Textreme.Close
Set Textreme = Nothing
Set Fso = Nothing
Rem 2 possible additions to MyLengthyStreaming
Let MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
End Function
Results Example:
Used htm Word File.JPG : https://imgur.com/mwihFBT
"ProMessage.htm" ( Saved from Word as .htm ) : https://app.box.com/s/cbtodk5srg76a5lowfemrdvei91mfmdq
Attachment 1969
Recieved Email gmail.jpg : https://imgur.com/x0NybLa :
Code:
'.To = "Doc.AElstein@t-online.de"
.To = "excelvbaexp@gmail.com"
Attachment 1972
Recieved EMail Telekom : https://imgur.com/wqPJSCt
Recieved EMail Telekom 2.JPG : https://imgur.com/o5mRkak
Code:
.To = "Doc.AElstein@t-online.de"
'.To = "excelvbaexp@gmail.com"
Attachment 1970Attachment 1971
_.________________________________________________ ____________________________
Uploaded file had to be done as .docx to get it to upload at excelfox ( .htm were not permitted to be uploaded )
To use in code it must be resaved as .html ( ' and path in code must be changed to reflect where you save it )
-
HTML Code seen in Text Editor
HTML as seen in Text Editor, for this Post:
http://www.excelfox.com/forum/showth...0524#post10524
OpenProMessageHTMLWithTextEditor.JPG : https://imgur.com/4zev9Kv
ProMessageHTMLInTextEditor.JPG : https://imgur.com/eTUd17q
Code:
HTML Code:
<body lang=DE style='tab-interval:35.4pt'>
<div class=WordSection1>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Times","serif";color:black'>T <span class=SpellE>Andale</span>
Mono</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='color:red'> </span><span
style='font-size:10.0pt;font-family:"Arial","sans-serif";color:red'>T Arial</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-family:"Arial Black","sans-serif";
color:#FF9900'>T Arial Black</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Comic Sans MS";color:#99CC00'>T Comic <span class=SpellE>Sans</span>
MS</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Courier New";color:#33CCCC'>T Courier New</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Georgia","serif";color:#3366FF'>T Georgia</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Helvetica","sans-serif";color:purple'>T <span class=SpellE>Helvetics</span></span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Impact","sans-serif";color:#999999'>T Impact</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Tahoma","sans-serif";color:#993300'>T <span class=SpellE>Tahoma</span></span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"monaco","serif";color:fuchsia'>T Terminal</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
color:olive'>T Times New Roman</span></p>
<p style='margin:0cm;margin-bottom:.0001pt'><span style='font-size:10.0pt;
font-family:"Trebuchet MS","sans-serif";color:#FF6600'>T <span class=SpellE>Trebuchet</span>
MS</span></p>
<p class=MsoNormalCxSpFirst><o:p> </o:p></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:9.0pt;line-height:115%;
font-family:"Verdana","sans-serif";color:#C00000'>W9 <span class=SpellE>Verdana</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-family:"Arial Narrow","sans-serif";
color:red'>W11 Arial <span class=SpellE>Narrow</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:14.0pt;line-height:115%;
font-family:"Batang","serif";color:#FFC000'>W14 <span class=SpellE>Batang</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:16.0pt;line-height:115%;
mso-ascii-font-family:Calibri;mso-fareast-font-family:Batang;mso-hansi-font-family:
Calibri;color:#92D050'>W16 Calibri<o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:18.0pt;line-height:115%;
font-family:"Cambria Math","serif";mso-fareast-font-family:Batang;color:#00B050'>W18
<span class=SpellE>Cambri</span> <span class=SpellE>Math</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:20.0pt;line-height:115%;
font-family:FangSong;color:#00B050'>W20 <span class=SpellE>FangSong</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:22.0pt;line-height:115%;
font-family:"Gungsuh","serif";color:#00B0F0'>W22 <span class=SpellE>Gungsuh</span><o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:24.0pt;line-height:115%;
font-family:GungsuhChe;color:#0070C0'>W24 <span class=SpellE>GungsuhChe</span></span><span
style='font-size:24.0pt;line-height:115%;font-family:"Franklin Gothic Heavy","sans-serif";
mso-fareast-font-family:Batang;color:#0070C0'> <o:p></o:p></span></p>
<p class=MsoNormalCxSpMiddle><span style='font-size:26.0pt;line-height:115%;
font-family:"Times New Roman","serif";mso-fareast-font-family:Batang;
color:#002060'>W26 Times New Roman<o:p></o:p></span></p>
<p class=MsoNormalCxSpLast><span style='font-size:28.0pt;line-height:115%;
font-family:"Franklin Gothic Heavy","sans-serif";mso-fareast-font-family:Batang;
color:#7030A0'>W28 Franklin <span class=SpellE>Gothic</span><span
style='mso-spacerun:yes'> </span>Heavy<o:p></o:p></span></p>
</div>
</body>
</html>
-
Modified initial function and additional second function for German telekom EMail workaround
Function codes discussed in this Post:
http://www.excelfox.com/forum/showth...0527#post10527
Code:
Public Function MyLengthyStreaming() As String
Rem 1 Make a long string from a Microsoft Word doc
'1(i) makes available the Library of stuff, objects, Methods etc.
Dim Fso As Object: Set Fso = CreateObject("Scripting.FileSystemObject")
'1(ii) makes the big File Object " Full path and file name of Word doc saved as .htm "
Dim FileObject As Object: Set FileObject = Fso.GetFile("G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\ProMessageTelekom.htm"): Debug.Print FileObject
'1(iii) sets up the data "stream highway"
Dim Textreme As Object: Set Textreme = FileObject.OpenAsTextStream(iomode:=1, Format:=-2) ' reading only, Opens using system default https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
'1(iv) pulls in the data, in our case into a simple string variable
Let MyLengthyStreaming = Textreme.ReadAll ' Let MyLengthyStreaming = Replace(MyLengthyStreaming, "align=center x:publishsource=", "align=left x:publishsource=")
Textreme.Close
Set Textreme = Nothing
Set Fso = Nothing
Let MyLengthyStreaming = MyLenghtyDiesScreaming_Telekom(MyLengthyStreaming) ' After this code line is done we have the string modified so that it gives the correct results in German Telekom Freemail t-online.de
Rem 2 possible additions to MyLengthyStreaming
'
'
'
'
End Function
'
' The second function below is mainly intended to make a modification to get the correct results in German Telekom Freemail t-online.de , but also the large html text not required from the start and a small amount at the end is also removed. (It does not need to be removed as it appears that it is ignored)
Public Function MyLenghtyDiesScreaming_Telekom(ByVal MyLengfyScream As String) As String ' Effectively this Dim's MyLenghtyDiesScreaming_Telekom as a String variable and MyLenghtyDiesScreaming_Telekom can be used as such in this function code. Assigning a variable to this in a main code will cause the value held by VBA in the variable MyLenghtyDiesScreaming_Telekom at that point to be out in the assigned variable, but fist the main code will be paused at this "calling" code line whilst the Function code is carried out. So we have the chance to do something in the function to fill that variable, MyLenghtyDiesScreaming_Telekom . We can take one or more things in in the ( ) to use . In this case we want to take a string in and then return it modified , hence the last code line is simply MyLenghtyDiesScreaming_Telekom = MyLengfyScream
Dim CntPus As Long ' A number constant for the positions of characters used in a couple of places. 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
' Take off all the first lot on unecessary required HTML
Let CntPus = InStr(1, MyLengfyScream, "<div class=WordSection1>", vbTextCompare) ' return the position (starting from the fist character , Looking in the string , for that text , doing a text comparison which is case insensitive )
Let MyLengfyScream = Mid(MyLengfyScream, CntPus + 26)
' Add to this array below all possible fonts in quotes I have to use Variant type as the VBA Array( ) Method used below pruduces a 1 dimmansional Array of Variant types. I may assing a dynamic Array of variant types to what the VBA Array( ) Function returns
Dim arsFonts() As Variant: Let arsFonts() = Array("""Andale Mono""", """Times""", """serif""", """Arial""", """sans-serif""", """Arial Black""", """Comic Sans MS""", """Courier New""", """Georgia""", """Helvetics""", """Impact""", """Tahoma""", """Terminal""", """monaco""", """Times New Roman""", """Trebuchet MS""", """Verdana""", """Arial Narrow""", """Batang""", """Calibri""", """Cambri Math""", """FangSong""", """Gungsuh""", """GungsuhChe""", """Franklin Gothic Heavy""")
Dim arschFont As Variant ' It is a required syntax that the stearing element in the For Each loop to be Variant type or Object type, ( the object type can be Object or ther specific object. if I do not specify specifically then VBVA defaults to all simialr ngs in the thing you are going through ' http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
' Look for things like "Font" and replace the " with an arbitrary string like ScrotumSack , so "Font" becomes ScrotumSackFontScrotumSack
For Each arschFont In arsFonts() ' Loop to look for and replce each Font held in "s with the same font but in 's
If InStr(1, MyLengfyScream, arschFont, vbTextCompare) > 1 Then ' case a Font in quotes , like "font" , so for that font in quotes... and ...
Dim FontSingleScrQuote As String: Let FontSingleScrQuote = Replace(arschFont, """", "ScrotumSack", 1, 2, vbBinaryCompare) ' ...Make a that font in ScrotumSack like ScrotumSackfontScrotumSack ... and ... I use ScrotumSack arbitrarily as I find it funny and I doubt anyone else does.. does use it, so I won't have that already in the text. I cannot go straight to using the ' because if I do that now then I won't be able to distinguisch the existing ' which I want to change to " in the next bit
Let MyLengfyScream = Replace(MyLengfyScream, arschFont, FontSingleScrQuote, 1, -1, vbTextCompare) ' .... replace all "fonts" with ScrotumSackfontsScrotumSack
Else ' no arsch Font in My lengfy scream
End If
Next arschFont
' replace any ' with " This is mainly intended to replace enclosed in ' strings like askjhhsa ='kasjhScrotumSackfontScrotumSackfcb qwq 63 = Bollocks' jdgsjag with askjhhsa ="kasjhScrotumSackfontScrotumSackfcb qwq 63 = Bollocks" jdgsjag
Let MyLengfyScream = Replace(MyLengfyScream, "'", """", 1, -1, vbTextCompare)
' Scratch my Scrotum sacks, - that is to say replace them with a with ' I can do this now since the existing ' have been changeed to " so the ScrotumSacks , which were originally "s , can now be chnged to 's
Let MyLengfyScream = Replace(MyLengfyScream, "ScrotumSack", "'", 1, -1, vbTextCompare)
' take last unecessary bit of HTML off
Let CntPus = InStrRev(MyLengfyScream, "</div>", -1, vbTextCompare) ' get the position counting from the left but looking from the right ( in MyLengfyScream , of </div> , start looking from end , make text comparison which is case insensitive )
Let MyLengfyScream = Left(MyLengfyScream, CntPus - 1)
' Finally we set here what is actually returned by virtue of effectively putting something in the pseudo variable MyLenghtyDiesScreaming_Telekom
Let MyLenghtyDiesScreaming_Telekom = MyLengfyScream
End Function
-
Code for RaghavendraPrabhu Make macro create unique files only once.If files exist amend them.
Code for RaghavendraPrabhu
For this Post in main Excel Forum
http://www.excelfox.com/forum/showth...ist-amend-them
Code:
Option Explicit
' https://stackoverflow.com/questions/46368771/how-to-create-a-new-workbook-for-each-unique-value-in-a-column?rq=1
' http://www.excelfox.com/forum/showthread.php/2237-Make-macro-create-unique-files-only-once-If-files-exist-amend-them
Sub ExportByName()
Dim unique(1000) As String
Dim wb(1000) As Workbook
Dim ws As Worksheet
Dim x As Long
Dim y As Long
Dim ct As Long
Dim uCol As Long
'On Error GoTo ErrHandler
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
'Your main worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
'Column G
uCol = 7
ct = 0
'get a unique list of users
For x = 2 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
If CountIfArray(ActiveSheet.Cells(x, uCol), unique()) = 0 Then
unique(ct) = ActiveSheet.Cells(x, uCol).Text
ct = ct + 1
End If
Next x
'loop through the unique list
For x = 0 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row - 1
If unique(x) <> "" Then
If Dir(ThisWorkbook.Path & "\" & unique(x) & ".xlsx", vbNormal) = "" Then 'If unique file does not exist
'add workbook
Workbooks.Add: Set wb(x) = ActiveWorkbook
ws.Range(ws.Cells(1, 1), ws.Cells(1, uCol)).Copy wb(x).Sheets(1).Cells(1, 1)
Else ' open workbook
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & unique(x) & ".xlsx"
Set wb(x) = ActiveWorkbook
End If
'loop to find matching items in ws and copy over
For y = 2 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
If ws.Cells(y, uCol) = unique(x) Then
'copy full formula over
'ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1)
'to copy and paste values
ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy
wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial (xlPasteValues)
wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)), 6).Value = Format(Date, "dd mmm yyyy")
End If
Next y
'autofit
wb(x).Sheets(1).Columns.AutoFit
'save when done
wb(x).SaveAs ThisWorkbook.Path & "\" & unique(x) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' & " " & Format(Now(), "mm-dd-yy")
wb(x).Close SaveChanges:=True
Else
'once reaching blank parts of the array, quit loop
Exit For
End If
Next x
' Master File change to current date:
Dim Lr As Long: Let Lr = ws.Cells(Rows.Count, 6).End(xlUp).Row
ws.Range("F2:F" & Lr & "").Value = Format(Date, "dd mmm yyyy")
' Application.ScreenUpdating = True
' Application.Calculation = xlCalculationAutomatic
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Public Function CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
End Function
-
Second Code for RaghavendraPrabhu Make macro create unique files only once.If files exist amend them.
Second Code for RaghavendraPrabhu
For this Post in main Excel Forum
http://www.excelfox.com/forum/showth...0541#post10541
Code:
Option Explicit
' https://stackoverflow.com/questions/46368771/how-to-create-a-new-workbook-for-each-unique-value-in-a-column?rq=1
' http://www.excelfox.com/forum/showthread.php/2237-Make-macro-create-unique-files-only-once-If-files-exist-amend-them
Sub ExportByName()
Dim unique(1000) As String
Dim wb(1000) As Workbook
Dim ws As Worksheet
Dim x As Long
Dim y As Long
Dim ct As Long
Dim uCol As Long
'On Error GoTo ErrHandler
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
'Your main worksheet info.
Set ws = ActiveWorkbook.Sheets("Sheet1")
Let uCol = 7 'Column G
Dim Strt As Long, Stp As Long: Let Strt = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row + 1: Stp = ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
Let ws.Range("F" & Strt & ":F" & Stp & "").Value = Format(Date, "dd mmm yyyy") ' adding the dates to the new rows
Let ws.Range("A" & Strt & ":A" & Stp & "").Value = Application.Evaluate("=row(" & Strt & ":" & Stp & ")-1") ' adding the S.no. to the new rows
ct = 0
'get a unique list of users
For x = 2 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
If CountIfArray(ActiveSheet.Cells(x, uCol), unique()) = 0 Then
unique(ct) = ActiveSheet.Cells(x, uCol).Text
ct = ct + 1
End If
Next x
'loop through the unique list
For x = 0 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row - 1
If unique(x) <> "" Then
If Dir(ThisWorkbook.Path & "\" & unique(x) & ".xlsx", vbNormal) = "" Then 'If unique file does not exist
'add workbook
Workbooks.Add: Set wb(x) = ActiveWorkbook
ws.Range(ws.Cells(1, 1), ws.Cells(1, uCol)).Copy wb(x).Sheets(1).Cells(1, 1)
Else ' open workbook
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & unique(x) & ".xlsx"
Set wb(x) = ActiveWorkbook
End If
'loop to find matching items in ws starting from where column F ( 6 ) has no entry and copy over
'For y = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row + 1 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
For y = Strt To Stp
If ws.Cells(y, uCol) = unique(x) Then
'copy full formula over
'ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1)
'to copy and paste values
ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy
wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)), 6).Value = Format(Date, "dd mmm yyyy")
End If
Next y
'autofit
wb(x).Sheets(1).Columns.AutoFit
'save when done
wb(x).SaveAs ThisWorkbook.Path & "\" & unique(x) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' & " " & Format(Now(), "mm-dd-yy")
wb(x).Close SaveChanges:=True
Else
'once reaching blank parts of the array, quit loop
Exit For
End If
Next x
'' Master File change to current date:
'Dim Lr As Long: Let Lr = ws.Cells(Rows.Count, 6).End(xlUp).Row
' ws.Range("F2:F" & Lr & "").Value = Format(Date, "dd mmm yyyy")
' Application.ScreenUpdating = True
' Application.Calculation = xlCalculationAutomatic
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Public Function CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
End Function
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg. 9C-br0lEl8V9xI0_6pCaR9
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg. 9bl7m03Onql9xI-ar3Z0ME
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg. 9gdrYDocLIm9xI-2ZpVF-q
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg. 9id_Q3FO8Lp9xHyeYSuv1I
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
ttps://www.youtube.com/watch?v=LP9fz2DCMBE
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg. 9wdo_rWgxSH9wdpcYqrvp8
ttps://www.youtube.com/watch?v=bFxnXH4-L1A
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
ttps://www.youtube.com/watch?v=GqzeFYWjTxI
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
3 Attachment(s)
Example VBA available checked Libraries Info, (Helpful for Later Early Binding)
Some sample data for other Posts and Threads:
http://www.excelfox.com/forum/showth...ing-Techniques
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
_.. you can get text displayed in the Immediate Window which you can copy.
Some example VBA available checked Libraries:
VBACheckedAvailableLibraries_1.JPG : https://imgur.com/scnHhHR
Attachment 1992
Here below the code output based on running in a Workbook which has the libraries checked as in the above screenshot:
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 HTML Object Library
Name: MSHTML
Buitin: Falsch
Minor: 0
Major: 4
FullPath: C:\Windows\system32\mshtml.tlb
GUID: {3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}
Type: 0
Isbroken: Falsch
Description: Microsoft XML, v6.0
Name: MSXML2
Buitin: Falsch
Minor: 0
Major: 6
FullPath: C:\Windows\System32\msxml6.dll
GUID: {F5078F18-C551-11D3-89B9-0000F81FE221}
Type: 0
Isbroken: Falsch
Description: Microsoft Forms 2.0 Object Library
Name: MSForms
Buitin: Falsch
Minor: 0
Major: 2
FullPath: C:\Windows\system32\FM20.DLL
GUID: {0D452EE1-E08F-101A-852E-02608C4D0BB4}
Type: 0
Isbroken: Falsch
This infomation above can be useful for Later Early Binding.
_.__________________
Note that for Broken Libraries the GUID infomation appears to be available also, so I would tend to use .AddFromguid for Later Early Binding simply as I may heve a better chance of collecting before hand the GUID infomation than I do for other properties:
MidTestJeffMoseToolsBroke.JPG : https://imgur.com/ZKq8BTr
Attachment 1993
MostPropertiesOfbrokenreferencesDontWork.JPG : https://imgur.com/FcVjDLl
Attachment 1994
In this example , the last two Library references were broken, but the GUID infomation is still available
-
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 |
Worksheet: Sheet1
-
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 |
Worksheet: Sheet1
-
Code for last post
Code:
Sub Raghavendra2b() 'http://www.excelfox.com/forum/showthread.php/2238-Copy-data-from-Unique-files-into-Masterfile-all-the-files-in-the-same-folder?p=10575#post10575
Dim LisWb As Workbook
Set LisWb = ThisWorkbook
Dim Ws2 As Worksheet, Ws1 As Worksheet
Set Ws2 = LisWb.Worksheets.Item(2): Set Ws1 = LisWb.Worksheets.Item(1):
Dim strWb As String: Let strWb = Dir(ThisWorkbook.Path & "\" & "*" & ".xlsx", vbNormal)
Do ' Loop through all .xlsx Files in same Folder as this workbook
Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & strWb
Let Ws2.Range("A2:A1000").Value = "=" & "'" & ThisWorkbook.Path & "\[" & strWb & "]Sheet1'!$A2"
Dim Lr As Long
Let Lr = Ws2.Range("A2:A1000").Find(what:=0, after:=Ws2.Range("A2"), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext).Row - 1
Let Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Value = "=" & "'" & ThisWorkbook.Path & "\[" & strWb & "]Sheet1'!G2"
Let Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Value = Ws1.Evaluate("=IF(ISERR(" & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & ")," & """""" & ",IF(" & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & "=0," & """""" & "," & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & "))")
'Let Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Value = Evaluate("=IF(ISERR(" & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & ")," & Empty & ",IF(" & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & "=0," & Empty & "," & Ws1.Range("G" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Address & "))") ' Does not remove the 0s ??
Let Ws1.Range("K" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").NumberFormat = "d.mmm yy"
Let Ws1.Range("K" & Ws2.Range("A2").Value + 1 & ":K" & Ws2.Range("A" & Lr & "").Value + 1 & "").SpecialCells(xlCellTypeConstants, xlNumbers).Offset(, 1).Value = Format(Date, "dd mmm yyyy") ' Put current date in cells 1 column to the left of cells in K column that have dates in
Let Workbooks("" & strWb & "").Worksheets.Item(1).Range("L2:L" & Lr & "").Value = Ws1.Range("L" & Ws2.Range("A2").Value + 1 & ":L" & Ws2.Range("A" & Lr & "").Value + 1 & "").Value ' Date values pasted in in last code line are given to correspondin cells in current open data workbook, first worksheet
Let Workbooks("" & strWb & "").Worksheets.Item(1).Range("L2:L" & Lr & "").NumberFormat = "d.mmm yy"
Workbooks("" & strWb & "").Close SaveChanges:=True
Let strWb = Dir
Loop While strWb <> ""
End Sub
-
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
-
Using this File:
“UpdatesOnVistaAspire4810TZG25thMarch.txt” : https://app.box.com/s/z90o8yj7iz0188yci34mu7gahe2tfhce
That file is downloaded into the same Folder as the file containing the code from the last Post.
This code line needs to have that text file reference in it such:
Let ActiviEL = ThisWorkbook.Path & "\UpdatesOnVistaAspire4810TZG25thMarch.txt"
Run code entering these search values when prompted
2553154 2726958 2965291 2920813 3054873 974554
Here the output string
You looked for
2553154
2726958
2965291
2920813
3054873
974554
Finded was
_.______________________________________________
Using this File:
“UpdatesAcerMartinWin7Pro64Bit26thMarch.txt” : https://app.box.com/s/8m96l0e7yh1wcb15y06eaaz6a7vtjzgd
That file is downloaded into the same Folder as the file containing the code from the last Post.
This code line needs to have that text file reference in it such:
Let ActiviEL = ThisWorkbook.Path & "\“UpdatesAcerMartinWin7Pro64Bit26thMarch.txt"
Run code entering these search values when prompted
2553154 2726958 2965291 2920813 3054873 974554
Here the output string
You looked for
2553154
2726958
2965291
2920813
3054873
974554
Finded was
-
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.
:(
-
Screenshots and extra notes in support of this Thread:
http://www.excelfox.com/forum/showth...0595#post10595
Distributed Files for the day for "Raghu.xlsx"
From Raghu
Using Excel 2007 32 bit
Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
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 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
7 |
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
8 |
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
9 |
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
10 |
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
11 |
37 |
ABC37 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
12 |
41 |
ABC41 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
13 |
45 |
ABC45 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
Worksheet: FromRaghu
Or if distributed today, 2nd April
Using Excel 2007 32 bit
Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
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 |
|
|
|
|
|
|
|
Raghu |
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
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 |
Worksheet: Tabelle1
_.________________________
In next Post could be a typical returned worksheet from a team member : ( based on similar files in the Zip Folder "WorkDistributedAndConsolidated 16MAR18.zip" )
-
From last post...
This could be a typical returned worksheet from a team member : ( based on similar files in the Zip Folder "WorkDistributedAndConsolidated 16MAR18.zip" )
Using Excel 2007 32 bit
Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
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 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
7 |
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
8 |
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
9 |
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
10 |
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
11 |
37 |
ABC37 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
12 |
41 |
ABC41 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
13 |
45 |
ABC45 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
Worksheet: FromRaghu
or this
Using Excel 2007 32 bit
Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
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 |
|
|
Raghu |
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
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 |
Worksheet: Tabelle1
-
For this Post
http://www.excelfox.com/forum/showth...0595#post10595
Daily data files completed by team members:
John
S No |
Item |
Price |
Qty |
Total |
Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Completed |
Consolidated |
2 |
ABC02 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
6 |
ABC06 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
10 |
ABC10 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
14 |
ABC14 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
18 |
ABC18 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
22 |
ABC22 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
|
26 |
ABC26 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
Worksheet: Tabelle1
Greg
3 |
ABC03 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
|
7 |
ABC07 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
|
11 |
ABC11 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
|
15 |
ABC15 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
|
19 |
ABC19 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
|
23 |
ABC23 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
Worksheet: Tabelle1
Margret
4 |
ABC04 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
8 |
ABC08 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
12 |
ABC12 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
16 |
ABC16 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
20 |
ABC20 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
24 |
ABC24 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
28 |
ABC28 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
|
32 |
ABC32 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
Worksheet: Tabelle1
Raghu
Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
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 |
|
|
Raghu |
3 |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
4 |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
5 |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
Raghu |
6 |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02. Apr 18 |
|
|
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 |
Worksheet: Tabelle1
-
From last Post... master File After Distribition and before Consolidation
File: “zMasterBeforeConsolidation.xlsm”
https://app.box.com/s/818q2ev3owpini2202n3dqp3xxicfeif
S No |
Item |
Price |
Qty |
Total |
Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Completed |
Consolidated |
Comments |
Team Member |
Checked |
1 |
ABC01 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
2 |
ABC02 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
3 |
ABC03 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
4 |
ABC04 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
6 |
ABC06 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
7 |
ABC07 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
8 |
ABC08 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
10 |
ABC10 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
11 |
ABC11 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
12 |
ABC12 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
14 |
ABC14 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
15 |
ABC15 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
16 |
ABC16 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
18 |
ABC18 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
19 |
ABC19 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
20 |
ABC20 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
22 |
ABC22 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
23 |
ABC23 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
24 |
ABC24 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
26 |
ABC26 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
27 |
ABC27 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
28 |
ABC28 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
30 |
ABC30 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
31 |
ABC31 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
32 |
ABC32 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
34 |
ABC34 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
35 |
ABC35 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
36 |
ABC36 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
37 |
ABC37 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
38 |
ABC38 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
39 |
ABC39 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
40 |
ABC40 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
41 |
ABC41 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
42 |
ABC42 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
43 |
ABC43 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
44 |
ABC44 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
45 |
ABC45 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Worksheet: OriginalData
-
Master File After First Consolidation
Using Excel 2007 32 bit
S No |
Item |
Price |
Qty |
Total |
Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Completed |
Consolidated |
Comments |
Team Member |
Checked |
1 |
ABC01 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02.04.2018 |
02.Apr.2018 |
|
Raghu |
|
2 |
ABC02 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
3 |
ABC03 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Greg |
|
4 |
ABC04 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02.04.2018 |
02.Apr.2018 |
|
Raghu |
|
6 |
ABC06 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
7 |
ABC07 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Greg |
|
8 |
ABC08 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02.04.2018 |
02.Apr.2018 |
|
Raghu |
|
10 |
ABC10 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
11 |
ABC11 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Greg |
|
12 |
ABC12 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02.04.2018 |
02.Apr.2018 |
|
Raghu |
|
14 |
ABC14 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
15 |
ABC15 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Greg |
|
16 |
ABC16 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
RT1 |
RT2 |
RT3 |
RT4 |
02.04.2018 |
02.Apr.2018 |
|
Raghu |
|
18 |
ABC18 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
19 |
ABC19 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
GT1 |
GT2 |
GT3 |
GT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Greg |
|
20 |
ABC20 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
22 |
ABC22 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
JT1 |
JT2 |
JT3 |
JT4 |
02.Apr.2018 |
02.Apr.2018 |
|
John |
|
23 |
ABC23 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
24 |
ABC24 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
26 |
ABC26 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
27 |
ABC27 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
28 |
ABC28 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
MT1 |
MT2 |
MT3 |
MT4 |
02.Apr.2018 |
02.Apr.2018 |
|
Margaret |
|
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
30 |
ABC30 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
31 |
ABC31 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
32 |
ABC32 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
34 |
ABC34 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
35 |
ABC35 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
36 |
ABC36 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
37 |
ABC37 |
$ 55.00 |
22 |
$ 1,210.00 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
38 |
ABC38 |
$ 13.66 |
7 |
$ 95.62 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
39 |
ABC39 |
$ 12.99 |
5 |
$ 64.95 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
40 |
ABC40 |
$ 8.51 |
12 |
$ 102.12 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
41 |
ABC41 |
$ 7.22 |
62 |
$ 447.64 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
42 |
ABC42 |
$ 3.99 |
35 |
$ 139.65 |
02.Apr.2018 |
|
|
|
|
|
|
|
John |
|
43 |
ABC43 |
$ 333.45 |
99 |
$ 33,011.55 |
02.Apr.2018 |
|
|
|
|
|
|
|
Greg |
|
44 |
ABC44 |
$ 11.99 |
1 |
$ 11.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Margaret |
|
45 |
ABC45 |
$ 741.99 |
101 |
$ 74,940.99 |
02.Apr.2018 |
|
|
|
|
|
|
|
Raghu |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Worksheet: OriginalData
-
Some similar results to the last from previous post
These are from a File supplied by Raghu
S No |
Item |
Price |
Qty |
Total |
Distributed |
Task1 |
Task2 |
Task3 |
Task4 |
Completed |
Consolidated |
Comments |
Team Member |
1 |
ABC01 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Raghu |
2 |
ABC02 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
15. Mrz 18 |
16. Mrz 18 |
|
John |
3 |
ABC03 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
GT1 |
GT2 |
GT3 |
GT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Greg |
4 |
ABC04 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
5 |
ABC05 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Raghu |
6 |
ABC06 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
15. Mrz 18 |
16. Mrz 18 |
|
John |
7 |
ABC07 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
GT1 |
GT2 |
GT3 |
GT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Greg |
8 |
ABC08 |
$ 11.99 |
1 |
$ 11.99 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
9 |
ABC09 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Raghu |
10 |
ABC10 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
15. Mrz 18 |
16. Mrz 18 |
|
John |
11 |
ABC11 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
GT1 |
GT2 |
GT3 |
GT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Greg |
12 |
ABC12 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
13 |
ABC13 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Raghu |
14 |
ABC14 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
15. Mrz 18 |
16. Mrz 18 |
|
John |
15 |
ABC15 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
GT1 |
GT2 |
GT3 |
GT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Greg |
16 |
ABC16 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
17 |
ABC17 |
$ 11.99 |
1 |
$ 11.99 |
15. Mrz 18 |
RT1 |
RT2 |
RT3 |
RT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Raghu |
18 |
ABC18 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
16. Mrz 18 |
16. Mrz 18 |
|
John |
19 |
ABC19 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
GT1 |
GT2 |
GT3 |
GT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Greg |
20 |
ABC20 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
21 |
ABC21 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
22 |
ABC22 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
JT1 |
JT2 |
JT3 |
JT4 |
16. Mrz 18 |
16. Mrz 18 |
|
John |
23 |
ABC23 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
|
|
|
|
|
|
|
Greg |
24 |
ABC24 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
25 |
ABC25 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
26 |
ABC26 |
$ 11.99 |
1 |
$ 11.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
John |
27 |
ABC27 |
$ 741.99 |
101 |
$ 74,940.99 |
15. Mrz 18 |
|
|
|
|
|
|
|
Greg |
28 |
ABC28 |
$ 55.00 |
22 |
$ 1,210.00 |
15. Mrz 18 |
MT1 |
MT2 |
MT3 |
MT4 |
16. Mrz 18 |
16. Mrz 18 |
|
Margaret |
29 |
ABC29 |
$ 13.66 |
7 |
$ 95.62 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
30 |
ABC30 |
$ 12.99 |
5 |
$ 64.95 |
15. Mrz 18 |
|
|
|
|
|
|
|
John |
31 |
ABC31 |
$ 8.51 |
12 |
$ 102.12 |
15. Mrz 18 |
|
|
|
|
|
|
|
Greg |
32 |
ABC32 |
$ 7.22 |
62 |
$ 447.64 |
15. Mrz 18 |
|
|
|
|
|
|
|
Margaret |
33 |
ABC33 |
$ 3.99 |
35 |
$ 139.65 |
15. Mrz 18 |
|
|
|
|
|
|
|
Raghu |
34 |
ABC34 |
$ 333.45 |
99 |
$ 33,011.55 |
15. Mrz 18 |
|
|
|
|
|
|
|
John |
Worksheet: OriginalData