Results 1 to 6 of 6

Thread: Date formating

  1. #1

    Date formating



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi everyone
    I need some help with a sheet I'm working on.... I've got it doing most of what I need but I have an issue with the date that its working with. The date is copied from "MRS Data" column "N", then duplicates are removed and then sorted, then pasted to another sheet. Trouble is this is a SAP data download and the date format isn't recognized by excel even though it reads as 20.04.2014, this can be fixed by the function =Date(Right(B3,4),Mid(B3,4,2),Left(B3,2)) how can i work this into my code below?

    The reason I need to do this is because with the date format the way it is excel doesn't see it as a date so can't sort it correctly, only sorts on the first part of the date so if a month rolls over the sorting will be wrong, start of the new month will move to the top of the list.

    Thanks in antisipation.

    Dave
    Code:
    Sub OffLineHrs()
    '
    ' OffLineHrs Macro
    ' Format offline hrs tab
    '
        Sheets("OffLineHrs").Select
        Columns("A:A").Select
        Selection.ClearContents
        Rows("1:1").Select
        Selection.ClearContents
        Columns("A:ZZ").Select
        Selection.EntireColumn.Hidden = False
        Sheets("MRS Data").Select
        Range("N5:N1000").Select
        Selection.Copy
        Sheets("Offline Equip List").Select
        Range("B3").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Range("$B$3:$B$1000").RemoveDuplicates Columns:=1, Header:=xlNo
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Add Key:=Range("B3"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Offline Equip List").Sort
            .SetRange Range("B3:B1000")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.Copy
        Sheets("OffLineHrs").Select
        Range("A2").Select
        ActiveSheet.Paste
            Range("A2:A100").Select
            ActiveSheet.Range("$A$2:$A$100").RemoveDuplicates Columns:=1, Header:=xlNo
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Add Key:=Range("A4"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Offline Equip List").Sort
            .SetRange Range("A4:A11")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
        
    Dim c00
    Dim v00
    Dim iRow As Integer: iRow = Range("A" & Rows.Count).End(xlUp).row
    c00 = Range("A1:A" & iRow).Value
    ReDim v00(0 To iRow * 3 - 1)
    For iRow = 0 To UBound(v00)
        If (iRow + 1) Mod 3 = 0 Then: v00(iRow) = "": Else: v00(iRow) = c00(Int(iRow / 3) + 1, 1)
    Next
    Range("A1").Resize(UBound(v00) + 1) = Application.Transpose(v00)
        Sheets("MRS Data").Select
        Range("K5:K1000").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Offline Equip List").Select
        Range("D3").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Range("$D$3:$D$1000").RemoveDuplicates Columns:=1, Header:=xlNo
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Offline Equip List").Sort.SortFields.Add Key:=Range("D3"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Offline Equip List").Sort
            .SetRange Range("D3:D1000")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
           Selection.Copy
        Sheets("OffLineHrs").Select
        Range("B1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Dim cell As Range
        For Each cell In Range("B30:zz30")
            If Not IsEmpty(cell) Then
                If cell.Value = 0 Then
                    cell.EntireColumn.Hidden = True
                End If
            End If
            
            Next
            Range("A2").Select
        ActiveCell.FormulaR1C1 = "Electrical"
        Range("A2").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 49407
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
            Range("A3").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "Mechanical"
        Range("A3").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 15773696
            .TintAndShade = 0
            .PatternTintAndShade = 0
            Range("A30").Select
        ActiveCell.FormulaR1C1 = "Total Offline Hrs"
        Columns("A:A").ColumnWidth = 20
            
        End With
            Rows("29:29").Select
        With Selection
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 90
            .AddIndent = False
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
            Selection.RowHeight = 100
            Range("A3").Select
    End Sub

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,479
    Articles
    0
    Excel Version
    365
    between:
    Range("N5:N1000").Select
    and:
    Range("N5:N1000").Select

    you could have:
    Code:
    xx = Selection.Value
    On Error Resume Next
    For i = LBound(xx) To UBound(xx)
      xx(i, 1) = DateSerial(Right(xx(i, 1), 4), Mid(xx(i, 1), 4, 2), Left(xx(i, 1), 2))
    Next i
    On Error GoTo 0
    The above will alter the contents of column N in MRS Data.

    You could instead keep that column as is and paste xx into the destination sheet by replacing your:
    Code:
    Sheets("MRS Data").Select
    Range("N5:N1000").Select
    Selection.Copy
    Sheets("Offline Equip List").Select
    Range("B3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    with:
    Code:
    Sheets("MRS Data").Select
    xx = Range("N5:N1000").Value
    On Error Resume Next
    For i = LBound(xx) To UBound(xx)
      xx(i, 1) = DateSerial(Right(xx(i, 1), 4), Mid(xx(i, 1), 4, 2), Left(xx(i, 1), 2))
    Next i
    On Error GoTo 0
    Sheets("Offline Equip List").Select
    Range("B3").Resize(UBound(xx)) = xx

  3. #3
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,479
    Articles
    0
    Excel Version
    365
    Correction:
    "between:
    Range("N5:N1000").Select
    and:
    Range("N5:N1000").Select"

    Should have been:
    "between:
    Range("N5:N1000").Select
    and:
    Selection.Copy"

  4. #4
    Thanks, I tried but couldn't get it work properly. I'm not that smart sometimes! All my spreadsheets end up being a selection of copy - paste code robbed from various sources....
    I've attached a workbook where this is used to show what I'm trying to do, the only difference from the code posted earlier is

    Sheets("Offline Equip List").Select is actually "Sheet1". Yes i did change this.

    So someone has a few moments to correct this code for the date issue I'd be most grateful. Also we can't play with the formatting of the "MRS Data" sheet.
    As mentioned in my first post, the intention of this sheet is to look at MRS Data sheet, produce a list of all the dates and then match criteria from column K and H then sum the hrs in column Q.
    At the moment it works great apart from the date issue......

    Thanks again for your help.

    DoubleDateSpace.xlsm

  5. #5
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,479
    Articles
    0
    Excel Version
    365
    That first snippet of code in my msg#2 was missing a final line:
    Selection=xx

    Sorry about that.

    The second suggestion would have worked EXCEPT… that having seen your OffLineHrs sheet, there are formulae in there which expect to see the date strings in the same way, so it still wouldn't have worked.

    You have a choice; either change the date strings on both sheets to real excel dates, or temporarily change the dates destined for the OffLineHrs to real dates, sort them, then change them back to their original date strings. I have done the latter in the attached.

    I've added a second button which does the same as the first button but without all the selecting.

    But it all seems very complicated. Take a look at Sheet2 and play with the pivot table there. It uses a copy of the MRS Data sheet (MRS Data(2)) as its source data except I converted the date strings to real dates in column N and removed a blank row between the headers and data, and removed the Autofilter.
    Attached Files Attached Files

  6. #6
    Thanks very much. I've incorporated your VersionB code into my spreadsheet. Looks good! No real problem that the date format isn't excel based, at least it sorts correctly on dates now. Great.
    I do have another area that I'm trying to sort out... Codes a bit long to post here so maybe another day.

    Thanks again for your help.
    Dave

Posting Permissions

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