Results 1 to 9 of 9
  1. #1
    2 Star Lounger
    Join Date
    Jun 2011
    Posts
    188
    Thanks
    62
    Thanked 0 Times in 0 Posts

    Date format to every last date of the month

    Hi All ,

    I have a text type date in A column i manage to write a code

    Code:
    Sub FormatDates()
    Dim r As Range
     Dim wks As Worksheet
       On Error Resume Next
        For Each r In [A:A].SpecialCells(2)
            r = Format(DateSerial(Left(r, 4), Right(r, 2), 1), "mmm,yyyy")
        Next
    End Sub
    code works fine change the 20106 to jun,2010 and 20108 to aug,2010 i need little adjustment in the code the code run for each sheet in a workbook except Main_sheet an change the month jun,2010 like 30-jun-2010 and aug,2010 to 31-aug-2010.


    Thanks in advance

    Cheers
    Last edited by farrukh; 2012-01-13 at 13:15.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Farrukh,

    This should do it. Note that I changed the assignment to r.offset for testing purposes.
    Code:
    Option Explicit
    
    Sub FormatDates()
    Dim r As Range
     Dim wks As Worksheet
       On Error Resume Next
        For Each r In [A:A].SpecialCells(2)
            r.Offset(0, 1) = Format(DateAdd("D", -1, DateSerial(Left(r, 4), (Right(r, Len(r) - 4) + 1), 1)), "dd-mmm-yyyy")
            Debug.Print r.Value
        Next
    End Sub
    Attached Images Attached Images
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    The line:
    r.Offset(0, 1) = Format(DateAdd("D", -1, DateSerial(Left(r, 4), (Right(r, Len(r) - 4) + 1), 1)), "dd-mmm-yyyy")


    can be simplified to:
    r.Offset(0, 1) = Format(DateSerial(Left(r, 4), (Right(r, Len(r) - 4) + 1), 0), "dd-mmm-yyyy")

    Instead of using DateAdd to subtract 1 day from the 1st day of the next month, you can just use the "zeroth day" of the next month (which is the last day of the month).

    [on a side note, using DateAdd to add or subtract days to me seems more complicated than just adding or subtracting directly from the serialdate. The unit of time in excel is days and you can add and subtract them directly]

    Steve

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Steve,

    Very Nice! Where did you learn about that Zeroth day thing?
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Where did you learn about that Zeroth day thing?
    I don't remember. It has been so long I don't even remember if it was something I noticed or read about.

    In addition to 0th day, you can use 0th month (= Dec) or even negative months and months > 12 (and negative days and days>31). It allows using the dateserial function in VB (or the date function in XL) to directly add/subtract days, months, and years. The limitations are that you can not go before (the quirky) Jan 0, 1900 (=Day 0) or beyond Dec 31, 9999 11:59:59.99 PM (no 5 digit year)

    Steve

  6. #6
    2 Star Lounger
    Join Date
    Jun 2011
    Posts
    188
    Thanks
    62
    Thanked 0 Times in 0 Posts
    Hi RetiredGeek,

    Thanks you for your kind help the code works but i do not know why it is not working on all sheet i have to select sheet and run then it works on selected sheet reset of the sheets ignored ?


    Thanks
    farrukh

  7. #7
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Farrukh,

    Sorry about that, I missed that in your OP. You just need to place the existing code in a loop to loop through the worksheets and ignore Main_sheet as below..
    Code:
    Option Explicit
     Sub FormatDates() 
          Dim r As Range
          Dim wks As Worksheet    
    
          On Error Resume Next     
        
          For Each wks in Workbook.Sheets
    
              If wks.name <> "Main_sheet" then
                For Each r In [A:A].SpecialCells(2)
                    r.Offset(0, 1) = Format(DateSerial(Left(r, 4), (Right(r, Len(r) - 4) + 1), 0), _
                      "dd-mmm-yyyy")    
                Next r
              End If
    
          Next wks
    
    End Sub
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  8. #8
    2 Star Lounger
    Join Date
    Jun 2011
    Posts
    188
    Thanks
    62
    Thanked 0 Times in 0 Posts
    Thank you sir

    I have change this line

    Code:
    For Each wks in Workbook.Sheets
    TO
    Code:
    For Each wks In ThisWorkbook.Worksheets
    Still did not formating all the sheets formats ?

    Thanks
    Farrukh

  9. #9
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Farrukh,

    This will teach me not to AIR code when I wake up in the middle of the night...sorry.
    Code:
    Option Explicit
     Sub FormatDates()
          Dim r As Range
          Dim wks As Worksheet
    
          On Error Resume Next
        
          For Each wks In ThisWorkbook.Sheets
    
              If wks.Name <> "Main_sheet" Then
                wks.Activate
                For Each r In [A:A].SpecialCells(2)
                    r.Offset(0, 1) = Format(DateSerial(Left(r, 4), (Right(r, Len(r) - 4) + 1), 0), _
                      "dd-mmm-yyyy")
                Next r
              End If
    
          Next wks
    
    End Sub
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

Posting Permissions

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