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