Issue with a macro

[juancarlos]

I’m using the below macro to copy a group of cells to another sheet, but I’m
getting an error message.

Can someone help me figure out what is wrong with the macro?

The idea is to copy the cell from text 180000 to 18:00:00 time

Dim bcell As Range '
Dim hh As String
Dim mm As String
Dim ss As String
r = 3
For Each bcell In Range("f51:f" & Trim(Str(20 + irows)))
hh = Mid(bcell, 1, 2)
mm = Mid(bcell, 3, 2)
ss = Mid(bcell, 5, 2)
sdate = hh & ":" & mm & ":" & ss
ddate = CDate(sdate)
Sheets("Sheet3").Cells(r, 5).Value = Format(ddate, "hh:mm:ss")
r = r + 1
Next bcell

 

[Susan]

sdate & ddate are not defined as variables.
maybe that's your problem.

susan

 

[Dave Peterson]

With no validity checks (to make sure that the fields are really numbers:

For Each bcell In Range("f51:f" & 20 + iRows).Cells
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
Sheets("Sheet3").Cells(r, 5).Value _
= TimeSerial(hh, mm, ss)
r = r + 1
Next bcell

 

[Gord Dibben]

Post the error message you get.

Works for me if the macro is run when the source data sheet is active


Gord Dibben MS Excel MVP

 

[Dave Peterson]

With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Juan Carlos]

Dave,
I tried to use what you sent but I’m getting the following error.

Run time Error 13 - Type Mismatch

Juan

 

[Juan Carlos]

Dave,
this one worked...Thanks for your help.
Juan

With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Juan Carlos]

Dave,
I have 2 more questions
The macro you created is moving data from F51-F75 to sheet 3. What can I add
to this macro so it also move data from F102-128 to sheet 3 in the last empty
cell in (r,5)


What can I add to macro below so it will do the following but also transfer
the data to the last empty row in column b.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False)
Thanks again

Juan

With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Dave Peterson]

Didn't that get answered in your other post?

Dim DestCell as range

With worksheets("Sheet3")
set destcell = .cells(.rows.count,"N").end(xlup).offset(1,0)
end with

worksheets("sheet1").range("L51:L" & 20 + irows).copy
destcell.pastespecial paste:=xlpastevalues

Dave,
I have 2 more questions
The macro you created is moving data from F51-F75 to sheet 3. What can I add
to this macro so it also move data from F102-128 to sheet 3 in the last empty
cell in (r,5)

What can I add to macro below so it will do the following but also transfer
the data to the last empty row in column b.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False)
Thanks again

Juan

With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Juan Carlos]

Dave,
The difference with this one is that there is a vlookup involve in the macro.

The other one is working to move one set of data to another sheet, but what
I also need to do is move more of data to the last empty cell.

Sorry that my questions are not clear but I’m very new on this.

Thanks

Didn't that get answered in your other post?

Dim DestCell as range

With worksheets("Sheet3")
set destcell = .cells(.rows.count,"N").end(xlup).offset(1,0)
end with

worksheets("sheet1").range("L51:L" & 20 + irows).copy
destcell.pastespecial paste:=xlpastevalues

Dave,
I have 2 more questions
The macro you created is moving data from F51-F75 to sheet 3. What can I add
to this macro so it also move data from F102-128 to sheet 3 in the last empty
cell in (r,5)

What can I add to macro below so it will do the following but also transfer
the data to the last empty row in column b.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False)
Thanks again

Juan

 

[Dave Peterson]

So this suggestion worked????

Dave,
The difference with this one is that there is a vlookup involve in the macro.

The other one is working to move one set of data to another sheet, but what
I also need to do is move more of data to the last empty cell.

Sorry that my questions are not clear but I’m very new on this.

Thanks

Didn't that get answered in your other post?

Dim DestCell as range

With worksheets("Sheet3")
set destcell = .cells(.rows.count,"N").end(xlup).offset(1,0)
end with

worksheets("sheet1").range("L51:L" & 20 + irows).copy
destcell.pastespecial paste:=xlpastevalues

 

[Juan Carlos]

Dave,
The suggestion worked, but I also have this one below that is moving data to
sheet 3 and also performing a vlookup. What I need is one that can move the
data to the last empty row available and also perform the vlookup.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False

Juan

So this suggestion worked????

Dave,
The difference with this one is that there is a vlookup involve in the macro.

The other one is working to move one set of data to another sheet, but what
I also need to do is move more of data to the last empty cell.

Sorry that my questions are not clear but I’m very new on this.

Thanks

 

[Dave Peterson]

I don't understand.

You want a value in that cell and an =vlookup() formula, too?

Maybe you can just record a macro when you plop in that =vlookup() formula into
the cell. And then continue recording when you change it to a value.

Dave,
The suggestion worked, but I also have this one below that is moving data to
sheet 3 and also performing a vlookup. What I need is one that can move the
data to the last empty row available and also perform the vlookup.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False

Juan

 

[Juan Carlos]

Yeap I think that will be easy. can you help me create something like that.

 

[Dave Peterson]

Record a macro when you do it manually.

If you have trouble implementing, then share that code in your next post.

In fact, share the formula that you see in the formulabar, too.

Yeap I think that will be easy. can you help me create something like that.

 

[Juan Carlos]

Dave,
I was able to record a macro for the vlooup. See below

Sheets("Sheet3").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200"), Type:=xlFillDefault
Range("B2:B200").Select

I haven’t being able to rearrange macro below so it will paste info in the
last available empty row.

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Dave Peterson]

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date
Dim LastRow as long 'Added

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell

'added
with worksheets("sheet3")
'if you can pick out a column that determines the last row to use
'(I used column A)
lastrow = .cells(.rows.count,"A").end(xlup).row
'or if you want to use row 200
'lastrow = 200
.range("b2:b" & lastrow).formular1c1 _
= "=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
end with

End Sub

Dave,
I was able to record a macro for the vlooup. See below

Sheets("Sheet3").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200"), Type:=xlFillDefault
Range("B2:B200").Select

I haven’t being able to rearrange macro below so it will paste info in the
last available empty row.

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Juan Carlos]

Dave,
How can I transfer data from text to time format using the macro below to .

Sheet 3 = 170000 Text
Sheet 4 = 17:00:00 hh:mm:ss

I know there is a formula that someone posted before, but I dont know how to
incorporate to the macro =TIME(LEFT(A2,2),MID(A2,3,2), RIGHT(A2,2))


With Worksheets("Sheet3")
Set DestCell = .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0)
End With
Worksheets("Bonus Section").Range("j5:j" & 300 + iRows).Copy
DestCell.PasteSpecial Paste:=xlPasteValues

Thanks

Juan

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date
Dim LastRow as long 'Added

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell

'added
with worksheets("sheet3")
'if you can pick out a column that determines the last row to use
'(I used column A)
lastrow = .cells(.rows.count,"A").end(xlup).row
'or if you want to use row 200
'lastrow = 200
.range("b2:b" & lastrow).formular1c1 _
= "=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
end with

End Sub

Dave,
I was able to record a macro for the vlooup. See below

Sheets("Sheet3").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200"), Type:=xlFillDefault
Range("B2:B200").Select

I haven’t being able to rearrange macro below so it will paste info in the
last available empty row.

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

 

[Dave Peterson]

That's what the macro did in this area:

It took the first 2 characters and treated them as hours. The next 2 as minutes
and the last 2 as seconds.

The vba timeserial() function is equivalent to the worksheet =time() function.

Dave,
How can I transfer data from text to time format using the macro below to .

Sheet 3 = 170000 Text
Sheet 4 = 17:00:00 hh:mm:ss

I know there is a formula that someone posted before, but I dont know how to
incorporate to the macro =TIME(LEFT(A2,2),MID(A2,3,2), RIGHT(A2,2))

With Worksheets("Sheet3")
Set DestCell = .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0)
End With
Worksheets("Bonus Section").Range("j5:j" & 300 + iRows).Copy
DestCell.PasteSpecial Paste:=xlPasteValues

Thanks

Juan

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date
Dim LastRow as long 'Added

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell

'added
with worksheets("sheet3")
'if you can pick out a column that determines the last row to use
'(I used column A)
lastrow = .cells(.rows.count,"A").end(xlup).row
'or if you want to use row 200
'lastrow = 200
.range("b2:b" & lastrow).formular1c1 _
= "=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
end with

End Sub

Dave,
I was able to record a macro for the vlooup. See below

Sheets("Sheet3").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]="""","""",VLOOKUP(RC[1],Sheet2!C[-1]:C,2,FALSE))"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200"), Type:=xlFillDefault
Range("B2:B200").Select

I haven’t being able to rearrange macro below so it will paste info in the
last available empty row.

Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub

:

Record a macro when you do it manually.

If you have trouble implementing, then share that code in your next post.

In fact, share the formula that you see in the formulabar, too.


Juan Carlos wrote:

Yeap I think that will be easy. can you help me create something like that.

:

I don't understand.

You want a value in that cell and an =vlookup() formula, too?

Maybe you can just record a macro when you plop in that =vlookup() formula into
the cell. And then continue recording when you change it to a value.

Juan Carlos wrote:

Dave,
The suggestion worked, but I also have this one below that is moving data to
sheet 3 and also performing a vlookup. What I need is one that can move the
data to the last empty row available and also perform the vlookup.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False

Juan

:

So this suggestion worked????

Juan Carlos wrote:

Dave,
The difference with this one is that there is a vlookup involve in the macro.

The other one is working to move one set of data to another sheet, but what
I also need to do is move more of data to the last empty cell.

Sorry that my questions are not clear but I’m very new on this.

Thanks

:

Didn't that get answered in your other post?

Dim DestCell as range

With worksheets("Sheet3")
set destcell = .cells(.rows.count,"N").end(xlup).offset(1,0)
end with

worksheets("sheet1").range("L51:L" & 20 + irows).copy
destcell.pastespecial paste:=xlpastevalues

Juan Carlos wrote:

Dave,
I have 2 more questions
The macro you created is moving data from F51-F75 to sheet 3. What can I add
to this macro so it also move data from F102-128 to sheet 3 in the last empty
cell in (r,5)

What can I add to macro below so it will do the following but also transfer
the data to the last empty row in column b.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False)
Thanks again

Juan
:

With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number <> 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub



Dave Peterson wrote:

With no validity checks (to make sure that the fields are really numbers:

For Each bcell In Range("f51:f" & 20 + iRows).Cells
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
Sheets("Sheet3").Cells(r, 5).Value _
= TimeSerial(hh, mm, ss)
r = r + 1
Next bcell

juancarlos wrote:

I’m using the below macro to copy a group of cells to another sheet, but I’m
getting an error message.

Can someone help me figure out what is wrong with the macro?

The idea is to copy the cell from text 180000 to 18:00:00 time

Dim bcell As Range '
Dim hh As String
Dim mm As String
Dim ss As String
r = 3
For Each bcell In Range("f51:f" & Trim(Str(20 + irows)))
hh = Mid(bcell, 1, 2)
mm = Mid(bcell, 3, 2)
ss = Mid(bcell, 5, 2)
sdate = hh & ":" & mm & ":" & ss
ddate = CDate(sdate)
Sheets("Sheet3").Cells(r, 5).Value = Format(ddate, "hh:mm:ss")
r = r + 1
Next bcell