Page 4 of 61 FirstFirst ... 234561454 ... LastLast
Results 31 to 40 of 604

Thread: Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

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

    Alternative Codes using [ ] shorthand

    Alternative Codes using [ ] shorthand
    Delete One Row From A 2D Excel Range Area

    ' To Test Function, Type some arbitrary values in range A1:E10, step through Main Test Code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17


    Code:
    ' Delete One Row From A 2D Excel Range Area
    ' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight  any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
    ' "Short hand", ShtHd, version using []
    '  requires snb and kalak "neat trick" so you can to all intents and purpose do very close to doing vba Un Hard coded in [ ] -    http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714       http://www.mrexcel.com/forum/excel-questions/899117-visual-basic-applications-range-a1-a5-vs-%5Ba1-a5%5D-benefits-dangers.html#post4331217
    '  and    Evaluate [ ]  Properties , AloPerties, Methods - Alan Dynamic Coding Wonks    http://www.excelforum.com/excel-programming-vba-macros/1141369-evaluate-and-differences-evaluated-array-return-needs-extra-bracket-for.html#post4400666
    Function FuR_AlanShtHd(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
    1   Let rngIn.Name = "snRgNme"
    5   Dim vTemp As Variant 'A varyable to fill with something and "suck and see" what you get
    10  ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())  '                 http://www.excelforum.com/excel-new-...ba-arrays.html                      http://www.mrexcel.com/forum/excel-q...ml#post4375354
    20  ' BUT in Cells form             arrOut() = Application.Index(Cells, rwsT(), clms())    '                      http://www.excelforum.com/excel-prog...t-range-2.html
    30  Dim ws As Worksheet '                                      ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template   etc.) in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
    40  Set ws = rngIn.Parent                                      ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-prog...ml#post4387191
    50                                ws.Range("K30").ClearContents: ws.Range("K30").Value = "Here I am, in this Worksheet!"
    60  'clms()
    70  Dim sClm As Long, Cs As Long 'Variable for Count of, Start Column. - This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular "Value", or ("Values" for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
    80  Let sClm = [=MIN(column(snRgNme))] '###Not needed now. Alternative using Spreadsheet Functions to avoid having to VBA ()(  ) after the Evaluate
    90  Dim clms() As Variant '           Evaluate Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
    95  Let clms() = [column(snRgNme)] '  snb  Range Name equivalent so ###                                                           'Let clms() = Evaluate("column(" & CL(sClm) & ":" & CL(sClm + (Cs - 1)) & ")")
    100
    160 'rwsT()
    170 Dim sRw As Long, Rs As Long, stpRw As Long '
    180  Let sRw = [=MIN(Row(snRgNme))] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()(  ) after the Evaluate '         Let sRw = rngIn.Areas.Item(1).Row
    190  Let Rs = [rows(snRgNme)]          'Let Rs = rngIn.Areas.Item(1).Rows.Count
    191  Let stpRw = [=MIN(Row(snRgNme)) + rows(snRgNme) - 1] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()(  ) after the Evaluate
    200
    240 'Get Full row indicies convenientally ( As 1 D "pseudo horizontal" Array ) from Spreadsheet Column() Function
    250 Dim rws() As Variant: Let rws() = Evaluate("column(" & CL(sRw) & ":" & CL(sRw + (Rs - 1)) & ")")
    251  Let vTemp = [CL(1)]: vTemp = [CL(MIN(Row(snRgNme)))] 'Both Return "A"
    252  vTemp = [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] 'Returns "J"
    254  Let rws() = [column(A:J)] ' Works
    257  'Let rws() = [column(CL(1):J)] ' Fails - Bug in Excel ! ? !
    258  'Let rws() = [column(CL(MIN(Row(snRgNme))):CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1))] ' Fails - Bug in Excel ! ? !
    260  Let rws() = Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")")
    270
    280 'Get full sequential row indicies in a string.
    290 Dim strRws As String: Let strRws = VBA.Strings$.Join(rws(), "|") '            'The VBA strings collection such as Join in there basic form must not returnn a string, they can also return for example Null, a special type of variant. That lies within it's "powers. - It will coerce even an Empty, or Null to a variant type and return that. That takes extra ( unecerssary work here ). If the result of a function is used as a string or assigned it to a string variable, use the $ form of the function. This results in faster executing code, because a conversion from a variant to a string is unnecessary.      http://www.excelforum.com/excel-new-...ml#post4084783      I believe that without $ a Strings collection Function coerces the first parameter into  Variant, with $ does not - that's why $ is preferable over no $ , it's theoretically more efficient.        http://www.xoc.net/standards/rvbacc....rSignFunctions
    300
    330 'Get String with missing row
    340 Dim strrwsD As String: Let strrwsD = Replace(strRws, "|" & FoutRw & "", "", 1, -1)
    350
    360 'Get Array ( 1 D Pseudo Horizontal ) of required row indicies
    370 Dim rwsS() As String '              The VBA Strings Collection Function, Split, used below returns a Field of String Element Types so the Array Elemments must be Declared appropriately. It must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
    375 Let rwsS() = VBA.Strings$.Split(strrwsD, "|", -1)
    380 'final Transposed Array for "magic neat" code line
    390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1) '          Both the type and size of Array is known so can be decared initially appropriatelly. Re Dim must be used as Dim only takes values, not variables
    400 Dim Cnt As Long
    410     For Cnt = 0 To UBound(rwsS())
    420      Let rwsT(Cnt, 1) = rwsS(Cnt)
    430     Next Cnt
    
    440 'Output Array
    450 Dim arrOut() As Variant
    460 Let arrOut() = Application.Index(ws.Cells, rwsT(), clms()) '"Magic neat" Code line in Cells first argument Form
    470
    480 Let FuR_AlanShtHd = arrOut()
    490
    500 ' . Transpose
    510 Dim rwsDotT() As Variant '         Transpose Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
    520 Let rwsDotT() = Application.Transpose(rwsS())
    530 Let arrOut() = Application.Index(ws.Cells, rwsDotT(), clms())
    540
    550 Let FuR_AlanShtHd = arrOut()
    '
    End Function
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  2. #32
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    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.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  3. #33
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

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

    Appendix Coding

    Coding for this main Thread post

    https://www.excelfox.com/forum/showt...ll=1#post24132

    Code:
    '  https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=18479&viewfull=1#post18479
    Sub CarriageReturnLineFeedExcelVBAFormula()  '   https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=24132&viewfull=1#post24132
    Call TidyCellView2
    Rem 2 Put formula in Cell
    ' 2a  CHAR(13)&CHAR(10)
     Let Range("B10") = "=""a""" & "&" & "CHAR(13)&CHAR(10)" & "&" & """b""" ' For VBA
    ' simplify a bit as  Evaluate(" ") can't return the  VBA  " & "  - it will simply join them
     Let Range("B10") = "=""a""&CHAR(13)&CHAR(10)&""b""" ' For VBA
    
    Dim strEval As String
     Let strEval = """" & "=" & """" & """" & "a" & """" & """" & "&" & "CHAR(13)&CHAR(10)" & "&" & """" & """" & "b" & """" & """" & """"
    Debug.Print strEval  '  "=""a""&CHAR(13)&CHAR(10)&""b"""
     Let Range("B10") = Evaluate(strEval)
     Let Range("B10") = Evaluate("""" & "=" & """" & """" & "a" & """" & """" & "&" & "CHAR(13)&CHAR(10)" & "&" & """" & """" & "b" & """" & """" & """")
    Debug.Print strEval  '  "=""a""&CHAR(13)&CHAR(10)&""b"""
    Debug.Print Evaluate("""" & "=" & """" & """" & "a" & """" & """" & "&" & "CHAR(13)&CHAR(10)" & "&" & """" & """" & "b" & """" & """" & """")    '   gives  ="a"&CHAR(13)&CHAR(10)&"b"   This is what gets put in the cell, the string seen in VBa
    ' final simplification - simply remove all   " & "   bits
    Let Range("B10") = Evaluate("""=""""a""""&CHAR(13)&CHAR(10)&""""b""""""")
    Let Range("B10") = Evaluate("=""=""""a""""&CHAR(13)&CHAR(10)&""""b""""""")
    
    ' 2b  vbCr & vbLf
    ' 2b(i)
    
    ' 2b(ii)
    '    strEval = """" & "=" & """" & """" & "a" & """" & """" & "&" &           "CHAR(13)&CHAR(10)"           & "&" & """" & """" & "b" & """" & """" & """"
     Let strEval = """" & "=" & """" & """" & "a" & """" & """" & "&" & """" & """" & vbCr & vbLf & """" & """" & "&" & """" & """" & "b" & """" & """" & """"
    
    Debug.Print strEval  '  "=""a""&""
    '                       ""&""b"""
    Debug.Print Evaluate(strEval)
     
     Let Range("C10") = Evaluate(strEval)
     Let Range("C10") = Evaluate("""" & "=" & """" & """" & "a" & """" & """" & "&" & """" & """" & vbCr & vbLf & """" & """" & "&" & """" & """" & "b" & """" & """" & """")
    ' final simplification - simply remove all   " & "   bits
     Let Range("C10") = Evaluate("""=""""a""""&""""" & vbCr & vbLf & """""&""""b""""""")
     Let Range("C10") = Evaluate("=""=""""a""""&""""" & vbCr & vbLf & """""&""""b""""""")
    
    
    
    
    End Sub

    Code:
    Public Sub TidyCellView()    '  A few things to make things in the demo look closer to what they are, to help demo purpposes
        With Rows("1:4")
         .RowHeight = 30                                                '  So we see two rows in a cell.  Sometimes it might happen automatically if we are playing around with text of two lines, but not always - This is because Excel is quite good at guessing what we want to see, and changes thins appropriately but it does not always guess correctly
         .WrapText = True                                               '  This makes sure that rows Usually Excel guesses we want this when we are playing around with line breaks in cell text,but not always. If it does not geuss correct then it might show a multi-line text in this sort of form, with the lines tacked on to each other with no indication of any line break characters that may be there     Line1Line2Line3      etc.
         .VerticalAlignment = xlTop:     .HorizontalAlignment = xlLeft  '  Thes two makes sure any text we have will start top left, otherwise Excel may occaisionally mess this up and give us misleading views
        End With
     Let Application.FormulaBarHeight = 2
    End Sub
    Public Sub TidyCellView2()    '  A few things to make things in the demo look closer to what they are, to help demo purpposes
        With Rows("10")
         .RowHeight = 30                                                '  So we see two rows in a cell.  Sometimes it might happen automatically if we are playing around with text of two lines, but not always - This is because Excel is quite good at guessing what we want to see, and changes thins appropriately but it does not always guess correctly
         .WrapText = True                                               '  This makes sure that rows Usually Excel guesses we want this when we are playing around with line breaks in cell text,but not always. If it does not geuss correct then it might show a multi-line text in this sort of form, with the lines tacked on to each other with no indication of any line break characters that may be there     Line1Line2Line3      etc.
         .VerticalAlignment = xlTop:     .HorizontalAlignment = xlLeft  '  Thes two makes sure any text we have will start top left, otherwise Excel may occaisionally mess this up and give us misleading views
        End With
     Let Application.FormulaBarHeight = 2
    End Sub
    
    Attached Files Attached Files
    Last edited by DocAElstein; 05-19-2024 at 05:00 PM.

  5. #35
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  6. #36
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #37
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

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

    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

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

    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  10. #40
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,452
    Rep Power
    10
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

Similar Threads

  1. Testing Concatenating with styles
    By DocAElstein in forum Test Area
    Replies: 2
    Last Post: 12-20-2020, 02:49 AM
  2. testing
    By Jewano in forum Test Area
    Replies: 7
    Last Post: 12-05-2020, 03:31 AM
  3. Replies: 18
    Last Post: 03-17-2019, 06:10 PM
  4. Concatenating your Balls
    By DocAElstein in forum Excel Help
    Replies: 26
    Last Post: 10-13-2014, 02:07 PM
  5. Replies: 1
    Last Post: 12-04-2012, 08:56 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
  •