View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
James D. Connelly James D. Connelly is offline
external usenet poster
 
Posts: 7
Default New here so be gentle

Darren

WOW!

I re-wrote the sub (see below) using your suggestion. The execution dropped
to 20 seconds! The result was exactly the same in that I got left with only
those items in sheet1 that were unique between the two sheets! I am going
to definitely have to remember those attributes to the Range object!
Thanks.

The re-written code is below (just in case anyone wants to import and use it
LOL). What I do is a lot of hobby related stuff, where I have lists to
sports cards, and this procedure sure helps a lot!

You obviously have a lot of experience and know where to look to find
answers (which is always more than half the battle).

10:38:34
10:38:14
0:0:20
The time did not change whether ScreenUpdating was True or False... That is
simply amazing. Thanks.
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Public Sub I_Have_2()
Application.ScreenUpdating = False
Dim txCardName As String
Dim txOtherName As String
Dim iTotalNumCellsS2 As Integer
Dim iTotalNumCellsS1 As Integer
Dim Start
Dim Endtime
Dim TotalTime
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer

x = 0
Start = Time

Sheets("Sheet1").Select
Range("A1").Select

iTotalNumCellsS1 = Range("A1").CurrentRegion.Rows.Count

Sheets("Sheet2").Select
Range("A1").Select

iTotalNumCellsS2 = Range("A1").CurrentRegion.Rows.Count

y = iTotalNumCellsS1
x = iTotalNumCellsS2
a = 0

Do While a < iTotalNumCellsS2
txCardName = Sheets("Sheet2").Range("A1").Offset(a, 0).Value
b = 0
Do While b < iTotalNumCellsS1
txOtherName = Sheets("Sheet1").Range("A1").Offset(b, 0).Value
If txCardName = txOtherName Then
Sheets("Sheet1").Range("A1").Offset(b, 0).Value = ""
b = iTotalNumCellsS1 + 1
ElseIf txCardName < txOtherName Then
b = b + 1
End If
Loop
a = a + 1
Loop
Endtime = Time
TotalTime = Endtime - Start
Application.ScreenUpdating = True
MsgBox (Start & " " & Endtime & " " & TotalTime)


End Sub

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


"Darren Hill" wrote in message
news:op.s1wpjg0bed89cl@omega...
Hi James (and Ken, I appear to be stalking you...)

Surely there must be an easy way to get a number of rows with data in a
column easier than the sledge hammer method I use below.


There are a few. For example:
NumberRows = Range("A1").CurrentRegion.Rows.Count
Using .End(xlDown) is another:
NumberRows = Range("A1").End(xldown).Row

You're using the .Select method a lot - this is really slow (it makes your
loop much slower), and you can usually avoid it by addressing the cell you
want directly, rather than selecting it.directly. As Ken mentioned,
switching off application.screenupdating can be very useful.

You said you wanted to compare two ranges and find the unique values. It
can be done using Find (though I'll admit this isn't tested).


Sub Test()
Dim myCell As Range, rngFoundItems As Range
Dim firstRange As Range, secondRange As Range

Set firstRange = Sheets("Sheet1").Range("a1").CurrentRegion.Resize( , 1)
Set secondRange = Sheets("Sheet2").Range("a1").CurrentRegion.Resize( , 1)
For Each myCell In firstRange
Set rngFound = secondRange.Find(What:=myCell.Value, LookAt:=xlPart)
If Not rngFound Is Nothing Then
' this means theres a duplication
' the current cell is matched by a cell in the secondrange
' enter appropriate code here, if any

Else
' these means mycell.value is not duplicated in secondrange
' it's unique.
MsgBox (myCell.Address & " is unique")
End If
Next myCell

' You then repeat the process, switching the ranges. This allows you to
find the
' cell values in both ranges that are unique
' In your case, this isn't needed so snip, snip, snip
For Each myCell In secondRange
Set rngFound = firstRange.Find(What:=myCell.Value, LookAt:=xlPart)
If Not rngFound Is Nothing Then
' this means theres a duplication
' the current cell is matched by a cell in the secondrange
' enter appropriate code here, if any

Else
' these means mycell.value is not duplicated in secondrange
' it's unique.
MsgBox (myCell.Address & " is unique")
End If
Next myCell




On Sat, 17 Dec 2005 02:06:55 -0000, Ken Johnson
wrote:

Hi James,
Have you included Application.ScreenUpdating = False to speed up the
code.
I had a quick glance and my old eyes didn't spot it. If you haven't
used it just type it in as a new line any where before the code starts
changing values on the sheet. Should result in big improvement in code
speed.
Also advanced filter has a "Unique records only option" that could be
useful.
Ken Johnson




--
------------------
Darren