Page 1 of 19 12311 ... LastLast
Results 1 to 10 of 186

Thread: Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

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

    Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

    Re: Appendix Thread. ( Codes for other Threads, HTML Tables, etc. )

    Hi
    . 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.
    . 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

    @ Moderators, Administrator:
    . 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 ) )
    .
    . Many Thanks
    Alan


    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.9hI1CQJMLLo9hWn2pGBe SS
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzkRujoMw9PblmXDQ14AaABAg.9hJRnEjxQrd9hJoCjomN I2
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgzPZbG7OvUkh35nXDd4AaABAg.9hJOZEEZa6p9hJqLC7El-w
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgwUcEpm8u6ZW3uOHXx4AaABAg.9hIlxxGY7t49hJsB2PWx C4
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgyvDj6NWT1Gxyy2JyR4AaABAg.9hIKlNPeqDn9hJskm92n p6
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=Ugwy7qx_kG9iUmMVO_F4AaABAg.9hI2IGUdmTW9hJuyaQaw qx
    https://www.youtube.com/watch?v=pkhazgI3LAo&lc=UgxesLhWNr_zNP0GUdh4AaABAg.9hI1CQJMLLo9hJwTB9Jl ob
    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
    Last edited by DocAElstein; 08-01-2023 at 03:23 PM.

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    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.9h740K6COOA9h77HSGDH 4A
    https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ
    https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG
    https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq
    https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
    https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 07-10-2023 at 07:29 PM.
    A Folk, A Forum, A Fuhrer ….

  3. #3
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10
    More Named Range Scope Wonks. Problems when Worksheet Scoped WorkSheet is different from Worksheet refered to in RefersTo:= Range Object argument



    Here is a another partial solution to the This Thread
    http://www.excelforum.com/excel-prog...acket-for.html

    It was also used to answer a few questions I had here:
    http://www.thespreadsheetguru.com/bl...o-named-ranges[I][COLOR="#000080"] ( Comment 22 )
    Here is what I wrote there:
    Reply Posted at
    http://www.thespreadsheetguru.com/bl...o-named-ranges
    6 th June 2016:

    Hi
    Hi Just feeding back from my "experiments" over the weekend_...
    http://www.excelforum.com/showthread...t=#post4404276
    _..So now o answer my questions:
    _1) I have not yet seen anything to suggest the answer to that is not yes.




    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgxzpgHWTLGj0C3q3gx4AaABAg.9gxsUMU53al9k5c8W6QG E8
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=Ugz2PzvZTJyxHz70eVF4AaABAg.9gxDYq2iiZ89h4ISxLD1 7d
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=Ugz2PzvZTJyxHz70eVF4AaABAg.9gxDYq2iiZ89h4LdsDET im
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=Ugz2PzvZTJyxHz70eVF4AaABAg.9gxDYq2iiZ89h32czjty R_
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgxzpgHWTLGj0C3q3gx4AaABAg
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=Ugw_smEwvNffCPr_nrB4AaABAg.9gvyL53lI1l9gxwd_9-V6z
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=Ugy7vmiHsQ0oUt2QCPZ4AaABAg.9gvoy4OW6lU9gxwxC5-rL9
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgzuX3uYmqJRtsZIbqF4AaABAg.9gth61YhXKB9gxxCMdRL A0
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgxcPC64RQGmXwO5rft4AaABAg.9gtQLXaeg0e9gxxNuc5C CM
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgwCY8vOs1DFHgYSJwF4AaABAg.9godrFcyWYw9gxy1odpi Rj
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgyL5nh_j8w70-YBoUt4AaABAg.9goMcRjwjtc9gxyslvuZKx
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgwwWRgmRZNqJKptHR14AaABAg.9go-DbayTZa9gxzPbefHXf
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgwF3wECwc8tVoRmz6B4AaABAg.9go-5xLQM8P9gxzmB7nkVQ
    https://www.youtube.com/watch?v=xLCWtC6UYrM&lc=UgyRDmGTHnMdT7dl_qx4AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

    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.9oTkVdzfqfm9wlhQrYJP 3M
    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_Q3FO8Lp9xHyeYSuv 1I
    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.9oTkVdzfqfm9wlhQrYJP 3M
    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_rWgxSH9wdpcYqrv p8
    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

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316280#p316280
    https://eileenslounge.com/viewtopic.php?p=315915#p315915
    https://eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315744#p315744
    https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315680#p315680
    https://eileenslounge.com/viewtopic.php?p=315743#p315743
    https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
    https://eileenslounge.com/viewtopic.php?p=314950#p314950
    https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
    https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
    https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 04-16-2024 at 01:07 PM.
    A Folk, A Forum, A Fuhrer ….

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    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
    Last edited by DocAElstein; 10-23-2016 at 02:33 PM.
    A Folk, A Forum, A Fuhrer ….

  5. #5
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    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
    NelsonMessageBox.JPG




    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 )

    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




    
    Attached Files Attached Files
    Last edited by DocAElstein; 12-30-2023 at 02:27 AM.
    A Folk, A Forum, A Fuhrer ….

  6. #6
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10
    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
    A Folk, A Forum, A Fuhrer ….

  7. #7
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    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
    Last edited by DocAElstein; 02-05-2017 at 07:23 PM.
    A Folk, A Forum, A Fuhrer ….

  8. #8
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10
    '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
    A Folk, A Forum, A Fuhrer ….

  9. #9
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    Post 22 Before ( HTML )

    Post 22 Before
    http://www.excelfox.com/forum/showth...0090#post10090




    Excel 2007 32 bit
    CDEFGHIJ
    1121TEAM LEADER21.Dec.167:0018:0011:009:002:00
    2121TEAM LEADER22.Dec.167:0018:0011:009:002:00
    3121TEAM LEADER23.Dec.167:0015:008:009:000:00
    4121TEAM LEADER24.Dec.167:0018:0011:009:002:00
    5121TEAM LEADER25.Dec.167:0018:0011:009:002:00
    6121TEAM LEADER26.Dec.167:0018:0011:009:002:00
    7121TEAM LEADER27.Dec.167:0017:0010:009:001:00
    8121TEAM LEADER28.Dec.167:0018:0011:009:002:00
    929.Dec.16
    1030.Dec.16
    1131.Dec.16
    12121TEAM LEADER1.Jan.177:0018:0011:009:002:00
    13121TEAM LEADER2.Jan.177:0018:0011:009:002:00
    14121TEAM LEADER3.Jan.177:0018:0011:009:002:00
    15121TEAM LEADER4.Jan.177:0018:0011:009:002:00
    16121TEAM LEADER5.Jan.177:0018:0011:009:002:00
    17121TEAM LEADER6.Jan.17
    18121TEAM LEADER7.Jan.177:0018:0011:009:002:00
    19121TEAM LEADER8.Jan.177:0018:0011:009:002:00
    20121TEAM LEADER9.Jan.17
    21121TEAM LEADER10.Jan.177:0018:0011:009:002:00
    22121TEAM LEADER11.Jan.177:0018:0011:009:002:00
    23121TEAM LEADER12.Jan.177:0018:0011:009:002:00
    24121TEAM LEADER13.Jan.177:0018:0011:009:002:00
    25121TEAM LEADER14.Jan.177:3017:3010:009:001:00
    26121TEAM LEADER15.Jan.177:3017:3010:009:001:00
    27121TEAM LEADER16.Jan.177:3017:3010:009:001:00
    28121TEAM LEADER17.Jan.177:3017:3010:009:001:00
    29121TEAM LEADER18.Jan.177:0018:0011:009:002:00
    3019.Jan.17
    31121TEAM LEADER20.Jan.17
    32
    33
    34Normal Overtime  ----->Holiday Overtime  ----->

    121



    A Folk, A Forum, A Fuhrer ….

  10. #10
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,458
    Rep Power
    10

    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
    A Folk, A Forum, A Fuhrer ….

Similar Threads

  1. VBA to Reply All To Latest Email Thread
    By pkearney10 in forum Outlook Help
    Replies: 11
    Last Post: 12-22-2020, 11:15 PM
  2. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM
  3. Replies: 19
    Last Post: 04-20-2019, 02:38 PM
  4. Search List of my codes
    By PcMax in forum Excel Help
    Replies: 6
    Last Post: 08-03-2014, 08:38 AM

Posting Permissions

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