HH:MM cell format displayss 00:00 after running macro

[timlh42]

I have code written and placed in Worksheet Change which allows the user to put in time without colon's and displays the time as 05:00, 16:00 etc. The code works great. Here is what I am using:

If Intersect(Target, Range("D2:D77, I2:I77")) Is Nothing Then Exit Sub

On Error GoTo ErrHandler:

With Target
If IsNumeric(.Value) Then
Application.EnableEvents = False
Select Case .Value
Case 0
.NumberFormat = "hh:mm"
Case 1 To 99
.Value = TimeSerial(0, .Value, 0)
.NumberFormat = "hh:mm"
Case 100 To 2399
.Value = TimeSerial(Int(.Value / 100), .Value Mod 100, 0)
.NumberFormat = "hh:mm"
Case 10000 To 235959
.Value = TimeSerial(Int(.Value / 10000), _
Int((.Value Mod 10000) / 100), .Value Mod 100)
.NumberFormat = "hh:mm:ss"
Case 240000 To 245959
.Value = TimeSerial(0, Int((.Value Mod 10000) / 100), .Value Mod 100)
.NumberFormat = "hh:mm:ss"
Case Else
End Select
End If
End With
ErrHandler:
Application.EnableEvents = True


The problem is when I added code to run another macro. When the macro runs, it opens another workbook, copies certain cells and pastes them into a different column on the same worksheet where the user puts the times in. After that happens, it calls for another macro to match the data that was just input. That all works fine but then the cell that you input times into, displays as 00:00 no mater what time you put in.

Here is the macro that runs that causes this to happen:

Sub Open_Crewout()
Application.DisplayAlerts = False
On Error Resume Next


Application.ScreenUpdating = True
Dim ws1 As Worksheet, WB As Workbook, wb1 As Worksheet, wb2 As Worksheet, wb3 As Worksheet, wb4 As Worksheet, wb5 As Worksheet
Dim DestRow As Long
Dim DestRow2 As Long
Dim DestRow3 As Long
Dim DestRow4 As Long
Dim DestRow5 As Long
Dim TrimString As String
Dim mystring As Range

Set ws1 = Sheets("Sheet2")

Set WB = Workbooks.Open("\\d-387-01\Share\Public\ALL Ops - Maint Scheduling\Daily Crew Out Schedule 2017\Week of " & ws1.Range("P7").Text & " Crew-Out.Xlsm")



Set wb1 = WB.Sheets("MONDAY")
Set wb2 = WB.Sheets("TUESDAY")
Set wb3 = WB.Sheets("WEDNESDAY")
Set wb4 = WB.Sheets("THURSDAY")
Set wb5 = WB.Sheets("FRIDAY")



DestRow = ws1.Cells(Rows.Count, "Q").End(xlUp).Row + 1


Application.DisplayAlerts = False

With Application
.ScreenUpdating = False
.EnableEvents = False

If ws1.Range("C6").Value = "MONDAY" Then
wb1.Range("G57:G69").Copy
With ws1.Range("Q" & DestRow)
.Value = WorksheetFunction.Trim(.Value)
ActiveSheet.Paste Destination:=ws1.Range("Q1")



End With


End If


If ws1.Range("C6").Value = "TUESDAY" Then
wb2.Range("G57:G69").Copy
With ws1.Range("Q" & DestRow)
.Value = WorksheetFunction.Trim(.Value)

ActiveSheet.Paste Destination:=ws1.Range("Q1")
End With
End If


If ws1.Range("C6").Value = "WEDNESDAY" Then
wb3.Range("G57:G69").Copy
With ws1.Range("Q" & DestRow)
.Value = WorksheetFunction.Trim(.Value)


ActiveSheet.Paste Destination:=ws1.Range("Q1")
End With
End If


If ws1.Range("C6").Value = "THURSDAY" Then
wb4.Range("G57:G69").Copy
With ws1.Range("Q" & DestRow)
.Value = WorksheetFunction.Trim(.Value)
ActiveSheet.Paste Destination:=ws1.Range("Q1")
End With
End If


If ws1.Range("C6").Value = "FRIDAY" Then
wb5.Range("G57:G69").Copy
With ws1.Range("Q" & DestRow)
.Value = WorksheetFunction.Trim(.Value)
ActiveSheet.Paste Destination:=ws1.Range("Q1")
End With
End If


Application.DisplayAlerts = False


Workbooks("Week of " & ws1.Range("P7").Text & " Crew-Out.Xlsm").Close savechanges:=False



On Error Resume Next

MatchTrue

End With

End Sub


Sub MatchTrue()


Dim x As Long
For x = 9 To 117
If (Range("P" & x).Value = True And Range("B" & x).Value > "") Then
Range("C" & x).Value = "OFF"
End If
Next

ActiveSheet.Protect Password:="43884388", UserInterFaceOnly:=True, DrawingObjects:=False, AllowFormattingCells:=True
End Sub


I know this probably sounds pretty confusing but if anyone could provide any insight as to why this is happening I would be ever so grateful

 

[Logit]

.
Look at the command PasteSpecial.

Here is a link that basically discusses with examples. There are other sites that will give you better explanation and examples.

https://stackoverflow.com/questions/25461314/vba-copy-cells-value-and-format


For example :

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">[COLOR=#303336][FONT=inherit]Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Cells[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]i[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]3[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Copy
Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]2[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Cells[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]a[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]15[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]PasteSpecial Paste[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlPasteFormats
Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]2[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Cells[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]a[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]15[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]PasteSpecial Paste[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlPasteValues[/FONT][/COLOR]</code>

 

[timlh42]

Thank You!!!!!