Optimize macro that converts sec to hh:mm:ss

[piddy]

Hi everybody


I hope you can help me with 3 things.

The VBA code below works but I think it's a bit slow.


1. )
The macro is set to run auto when Excels open (Private Sub Workbook_Open), so if a person then saves the file, and then opens it again and macro is run, the numbers get corrupted.

I am thinking of adding some code like the following, so the macro should only run if the format is not hh:mm:ss., but I am not sure how to implement it into the code.

[I]if Range("R2").NumberFormat <> "h:mm:ss" then do[/I]

2.) If a cell is empty it also converts the format to "hh:mm:ss" and display the cell as 00:00:00 which shouldn't happen. If a cell is blank it should stay blank.


How can this be implemented?


3.) Can the code be written so it's faster?


Thanks in advance.


VBA code:

Sub Sec_to_correct_format()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim wb As Workbook: Set wb = ThisWorkbook
Set sheet_data = wb.Sheets("Data")
Set sheet_survey = wb.Sheets("Puzzel_survey_calls")
Const convert_sec_to_hh_mm_ss As String = 86400 '# sec to hh:mm:ss by (24*60*60)=86400
With sheet_data
    lRow = sheet_data.Range("R" & Rows.Count & ":S" & Rows.Count & ":T" & Rows.Count & ":U" & Rows.Count & ":V" & Rows.Count & ":W" & Rows.Count & ":X" & Rows.Count).End(xlUp).row
    Set MR1 = sheet_data.Range("R2:R" & lRow & ":S2:S" & lRow & ":T2:T" & lRow & ":U2:U" & lRow & ":V2:V" & lRow & ":W2:W" & lRow & ":X2:X" & lRow)
For Each cell In MR1
    cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
  
Next
        
End With
With sheet_survey
    lRow = sheet_survey.Range("C" & Rows.Count).End(xlUp).row
    Set MR2 = sheet_survey.Range("C2:C" & lRow)
For Each cell In MR2
    cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
  
Next
        
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
        
End Sub

 

[piddy]

Hi Again

I have a follow up questions which I hope someboday can help me with.

The code below is the same as the last post, which convert second into hh:mm:ss.

Sub Sec_to_correct_format()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim wb As Workbook: Set wb = ThisWorkbook
Set sheet_data = wb.Sheets("Data")
Const convert_sec_to_hh_mm_ss As String = 86400 '# sec to hh:mm:ss by (24*60*60)=86400
Dim i As Long
 
    With sheet_data
        For i = 2 To 4
        For Each cell In .Range(.Cells(2, i), .Cells(Rows.Count, i).End(3))
        If cell.NumberFormat <> "hh:mm:ss" And cell.Value <> "" Then
     
        cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:mm:ss")
        End If
        Next cell
        Next i
    End With
  
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
        
End Sub

I would like to display hours>24 as 25:,26:,...100: etc., but this doesnt happen in the conversation and results in the following:

Hours_decimal Seconds Converted format hh:mm:ss
23,267 83.760 23:16:00
51,567 185.640 03:34:00

 

[piddy]

Hi Again

I have a follow up questions which I hope somebody can help me with.

The code below is the same as the last post, which convert second into hh:mm:ss.

Sub Sec_to_correct_format()
 Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 Dim wb As Workbook: Set wb = ThisWorkbook
 Set sheet_data = wb.Sheets("Data")
Const convert_sec_to_hh_mm_ss As String = 86400 '# sec to hh:mm:ss by (24*60*60)=86400
 Dim i As Long
  
     With sheet_data
         For i = 2 To 4
         For Each cell In .Range(.Cells(2, i), .Cells(Rows.Count, i).End(3))
         If cell.NumberFormat <> "hh:mm:ss" And cell.Value <> "" Then
      
         cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:mm:ss")
         End If
         Next cell
         Next i
     End With
   
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
        
 End Sub

I would like to display hours>24 as 25:,26:,...100: etc., but this doesn't happen in the conversation and results in the following:

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Hours_decimal[/TD]
[TD]Seconds[/TD]
[TD]Converted format hh:mm:ss[/TD]
[/TR]
[TR]
[TD]23,267 [/TD]
[TD]83.760 [/TD]
[TD]23:16:00[/TD]
[/TR]
[TR]
[TD]51,567 [/TD]
[TD]185.640 [/TD]
[TD]03:34:00[/TD]
[/TR]
</tbody>[/TABLE]

Here 1st row is converted correctly because hours are below <24.
The last row conversion isn't correct because it should result in 51:34:00 and not 03:34:00.

I searched on Google and found that I should use the format "[hh]:mm:ss" in my code instead of "hh:mm:ss" but when I try that I get the following:

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Hours_decimal[/TD]
[TD]Seconds[/TD]
[TD]Converted format [hh]:mm:ss[/TD]
[/TR]
[TR]
[TD][TABLE="width: 131"]
<tbody>[TR]
[TD]23,267[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[TD]83.760[/TD]
[TD]:12:00[/TD]
[/TR]
[TR]
[TD]51,567 [/TD]
[TD]185.640[/TD]
[TD]:01:00[/TD]
[/TR]
</tbody>[/TABLE]


I hope somebody can point to a solution for this.

I greatly appreciate your help.