Solved: Multiple replace slowing macro

[kathyb0527]

Hi everyone,
I have a macro that takes columns from multiple worksheets and puts them in one worksheet for a client. The problem I have is that the timepoint format that comes out of our database is xXX:XX:XX which the client wants reported as Day X hour x. I've written the code as

With rTimeptCol
.Replace What:="#N/A", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:00:00", Replacement:="Day 1, Pre-dose", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:00:30", Replacement:="Day 1, 0.5 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:01:00", Replacement:="Day 1, 1 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:01:30", Replacement:="Day 1, 1.5 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:02:00", Replacement:="Day 1, 2 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:03:00", Replacement:="Day 1, 3 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:04:00", Replacement:="Day 1, 4 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:06:00", Replacement:="Day 1, 6 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:08:00", Replacement:="Day 1, 8 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:10:00", Replacement:="Day 1, 10 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="001:12:00", Replacement:="Day 1, 12 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="003:00:00", Replacement:="Day 2, 24 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="005:00:00", Replacement:="Day 3, 48 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="007:00:00", Replacement:="Day 4, 72 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="009:00:00", Replacement:="Day 5, 96 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="011:00:00", Replacement:="Day 6, 120 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="013:00:00", Replacement:="Day 7, 144 hr", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With

which as you can imagine, slows down the code quite a bit. Any help would be greatly appreciated.

Thank you for your time,
kathyb0527

[mdmackillop]

Can you post a file with sample times?

[kathyb0527]

Here is a workbook containing all of the worksheets I use (minus some confidential information). I get sheets 1-3 from our database and use resizerows to put the data into the "client table" sheet. The "Timepoint correction" sheet is my twisted way of getting the Day hour information. Sheet 3 contains the times and equivalents. I could not think of a way to use Column B on sheet 1 to create timepoints so I'm open to any ideas. This will be a very big project, and I'll have to generate this table 2-3 times a week for about 2 months as data comes in. Again, thanks for your time.

Kathyb0527

[Paul_Hossler]

There's a number of hard coded values that you can change to meet your needs, but this only goes thru the data one time and might give you some ideas. Probably could stand some error checking too



Sub TryNumber1()
Dim rTimes As Range, rCell As Range

Set rTimes = Worksheets("Sheet 3").Range("B:B").SpecialCells(xlCellTypeConstants)

Application.ScreenUpdating = False

For Each rCell In rTimes.Cells
With rCell
Application.StatusBar = "Processing row " & .Row

Select Case .Value
Case "001:00:00": .Value = "Day 1, Pre-dose"
Case "001:00:30": .Value = "Day 1, 0.5 hr"
Case "001:01:00": .Value = "Day 1, 1 hr"
Case "001:01:30": .Value = "Day 1, 1.5 hr"
Case "001:02:00": .Value = "Day 1, 2 hr"
Case "001:03:00": .Value = "Day 1, 3 hr"
Case "001:04:00": .Value = "Day 1, 4 hr"
Case "001:06:00": .Value = "Day 1, 6 hr"
Case "001:08:00": .Value = "Day 1, 8 hr"
Case "001:10:00": .Value = "Day 1, 10 hr"
Case "001:12:00": .Value = "Day 1, 12 hr"
Case "003:00:00": .Value = "Day 2, 24 hr"
Case "005:00:00": .Value = "Day 3, 48 hr"
Case "007:00:00": .Value = "Day 4, 72 hr"
Case "009:00:00": .Value = "Day 5, 96 hr"
Case "011:00:00": .Value = "Day 6, 120 hr"
Case "013:00:00": .Value = "Day 7, 144 hr"
Case Else
rCell.ClearContents
End Select
End With
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub



Paul

[kathyb0527]

Thanks Paul! I've got limited knowledge and don't always know the most efficient way to do things. This should help tremendously.

Kathyb0527

[MattKlein]

Kathy,

I wrote you a function that will convert your time stamp to the format it looks like you're using. It will take any time and return your given format.


Public Function Convert(OurTime As String) As String
Dim Day As Integer, PartHour As Integer, PHStr As String

If OurTime = "001:00:00" Then
Convert = "Day 1, Pre-dose"
Exit Function
End If

Day = (CInt(Mid(OurTime, 1, 3)) + 1) / 2
PartHour = CInt(Mid(OurTime, 8, 2)) * 100 / 60
If PartHour <> 0 Then
PHStr = "." & PartHour
End If

Convert = "Day " & Day & ", " & ((Day - 1) * 24) + CInt(Mid(OurTime, 5, 2)) & PHStr & " hr"
End Function


Let me know how it works!

-Matt

[Paul_Hossler]

Well, there's a number of hard coded things in the macro that I don't really like, but if your data is consistant (always Col B), if should be OK, but you can always tweak it. You can replace Worksheets("Sheet 3") with ActiveSheet and the macro will run on Col B of whatever sheet is active not just Sheet 3.

I ran it twice and the second time the Case Else was executed and it cleared the data of each cell (that's a 'duh' on me). You could put in checks for that also.

The Select Case has the specific things to test for, so if your external source adds a new one, the Case Else will cleal it, so if that's a possibility, you might want to a MsgBox to the Case Else so that you know.

Paul

[kathyb0527]

Wow, lots to think about.

Paul, I tried incorporating your macro into what I have written and it didn't quite work (I get a type mismatch which is probably because of something I wrote in a rush). Do you think it would be better to make it separate sub and have my code call it?

Matt, I love that function. I've already found more uses for it.

Thank you both for your help.

[Paul_Hossler]

Well, programming styles differ. The bit I had could be included in the main Sub, or you could define "my" sub with parameters to be passed at run time. That would make it more modular:

Sub ChangeTimes (rTimesColumn as Range)

etc

You could also change it so that instead of replacing the original in it's location, the new value is added to the next column

What line generates the Type Mismatch?

Paul

[kathyb0527]

Not a problem anymore. I had assigned rCell to a different range earlier in the code. Once I changed the name, it ran with no problem.

Thanks for all of your help!

Kathyb