Date formating

4lowie

New member
Joined
Apr 27, 2014
Messages
3
Reaction score
0
Points
0
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
 
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
 
Correction:
"between:
Range("N5:N1000").Select
and:
Range("N5:N1000").Select"

Should have been:
"between:
Range("N5:N1000").Select
and:
Selection.Copy"
 
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.

View attachment DoubleDateSpace.xlsm
 
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.
 

Attachments

  • ExcelGuru2967DoubleDateSpace.xlsm
    194.4 KB · Views: 11
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
 
Back
Top