needs to run faster
 

Ok, here is the code I currently have. I got some from on here, and
some,(the really slow part) is my first attempt at VBA. The changes I
need to make are as follows. The workbook contains sheets called 1, 2,
3, 4, 5, etc, all the way to 31. (seperate sheet for each day of the
month). I need this formula to work on the active sheet, no matter
which sheet it is on. The second problem is the speed of the DO UNTIL
loop. The 400 is there because I know that none of teh data that is
copied into the A column goes beyond 400 rows. Any help would eb
greatly appreciated

Sub test()
Call RemoveDuplicates("=")
Call tr
End Sub


Public Sub RemoveDuplicates(ByVal ReplaceCharacter As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range


Set wks = Sheets("1")
Set rngToSearch = wks.Range("a:a")
Set rngFound = rngToSearch.Find(What:=ReplaceCharacter & _
ReplaceCharacter, LookAt:=xlPart)


Do While Not rngFound Is Nothing
rngToSearch.Replace What:=ReplaceCharacter, _
Replacement:=""
Set rngFound = rngToSearch.Find(What:=ReplaceCharacter & _
ReplaceCharacter, LookAt:=xlPart)
Loop
End Sub
Sub tr()
Dim i As Integer
i = 0
Do Until i = 400
i = i + 1
If Cells(i, 1) = "" Then Cells(i, 1).Delete
Cells(i, 2).Value = Application.Trim(Cells(i, 1))
Loop


End Sub

needs to run faster
 

Not sure exactly what TR is supposed to do but try this without the
loop. This deletes any blank cells in column A and then in Column B
enters a trimmed version of column A's contents. SAVE your work before
testing this.

Sub tr()
Dim eRow As Long
eRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & eRow).SpecialCells(xlCellTypeBlanks).Delete
eRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("B1:B" & eRow)
.FormulaR1C1 = "=trim(rc[-1])"
.Value = .Value
End With
End Sub

Hope this helps
Rowan

wrote:
Ok, here is the code I currently have. I got some from on here, and
some,(the really slow part) is my first attempt at VBA. The changes I
need to make are as follows. The workbook contains sheets called 1, 2,
3, 4, 5, etc, all the way to 31. (seperate sheet for each day of the
month). I need this formula to work on the active sheet, no matter
which sheet it is on. The second problem is the speed of the DO UNTIL
loop. The 400 is there because I know that none of teh data that is
copied into the A column goes beyond 400 rows. Any help would eb
greatly appreciated

Sub test()
Call RemoveDuplicates("=")
Call tr
End Sub


Public Sub RemoveDuplicates(ByVal ReplaceCharacter As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range


Set wks = Sheets("1")
Set rngToSearch = wks.Range("a:a")
Set rngFound = rngToSearch.Find(What:=ReplaceCharacter & _
ReplaceCharacter, LookAt:=xlPart)


Do While Not rngFound Is Nothing
rngToSearch.Replace What:=ReplaceCharacter, _
Replacement:=""
Set rngFound = rngToSearch.Find(What:=ReplaceCharacter & _
ReplaceCharacter, LookAt:=xlPart)
Loop
End Sub
Sub tr()
Dim i As Integer
i = 0
Do Until i = 400
i = i + 1
If Cells(i, 1) = "" Then Cells(i, 1).Delete
Cells(i, 2).Value = Application.Trim(Cells(i, 1))
Loop


End Sub

needs to run faster
 

Thanls, but this created even more problems and didn't run any faster.
Now all teh formulas are showing ref#