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]

Anyone please?

 

[Jan Mach]

If the number of seconds is in the variable s& and one day has 24*60*60=86400 seconds then s/86400 is a double = number of days. Hence
Format$(

s / 86400, "hh:nn:ss")
gives the result you want.
​

 

[piddy]

Hi Jan. That's already in the macro. My question was given in 1) and 2), how to only calculate non tt:hh:ss formatted cells and don't format blank cells.

 

[piddy]

I hope someone can help with my questions under 1) and 2).
Please

 

[steve the fish]

Its probably better to start at the beginning. What data is in these cells? Its possible to loop through testing the format and then only changing appropriate cells but it isnt going to be any quicker. How for example are you going to refresh the data etc.

 

[Osvaldo Palmeiro]

Maybe this could be a way:

For Each cell In MR1
   If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
    'do convertion
   End If
  Next cell

 

[piddy]

Thanks. That worked and it was quite simple.

There can be about 20.000 + rows in data. Is there a way to write it more efficient ?
I have updated the code below:

[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_opkald")

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
        If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
        cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
  
    End If
    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
        If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
        cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
  
    End If
  
    Next
        
    End With

Application.EnableEvents = True
Application.ScreenUpdating = True
        
End Sub

/CODE]

 

[Osvaldo Palmeiro]

You could try something like:

Replace this part of your code

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
        If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
        cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
  
    End If
    Next
        
    End With

By the lines below

Dim i As Long
 
 With sheet_data
   For i = 18 To 24
   For Each cell In .Range(.Cells(2, i), .Cells(Rows.Count, i).End(3))
    If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
     'do convertion
    End If
   Next cell
  Next i
 End With

Also you could try changing Calculation to Manual at the begining of the code (Application.Calculation = xlCalculationManual)
and then restore it to Automatic at the end (Application.Calculation = xlCalculationAutomatic) if this is the case

 

[piddy]

Hi Osvaldo
Thank you very much for this. It is a bit quicker, so I am happy

Here is the new code:

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")
Set sheet_survey = wb.Sheets("Puzzel_survey_opkald")
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 = 18 To 24
   For Each cell In .Range(.Cells(2, i), .Cells(Rows.Count, i).End(3))
      If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
     
     cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
    
    End If
   Next cell
  Next i
 End With
 
  With sheet_survey
   For i = 3 To 3
   For Each cell In .Range(.Cells(2, i), .Cells(Rows.Count, i).End(3))
      If cell.NumberFormat <> "h:mm:ss" And cell.Value <> "" Then
     
     cell.Value = Format((cell.Value / convert_sec_to_hh_mm_ss), "hh:nn:ss")
    
    End If
   Next cell
  Next i
 End With
 
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
        
End Sub