View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson[_3_] Dave Peterson[_3_] is offline
external usenet poster
 
Posts: 2,824
Default Variable results to new workbook

How about:
Option Explicit

Sub compare()
Dim rng1 As Range
Dim rng2 As Range
Dim res As Variant
Dim cell As Range
Dim newWks As Worksheet
Dim i As Long
Dim myNumbers() As Variant 'as long???
Dim myFileName As Variant

'With Workbooks("work1.xls").Sheets("Sheet1")
With Worksheets("sheet1")
Set rng1 = .Range(.Range("A2"), .Range("A2").End(xlDown))
End With


'With Workbooks("work2.xls").Sheets("Sheet1")
With Worksheets("sheet2")
Set rng2 = .Range(.Range("A2"), .Range("A2").End(xlDown))
End With

i = 0
For Each cell In rng1
res = Application.Match(cell.Value, rng2, 0)
If IsError(res) Then
i = i + 1
ReDim Preserve myNumbers(1 To i)
myNumbers(i) = cell.Value
End If
Next

If i 0 Then
'found at least one mismatch
Set newWks = Workbooks.Add(1).Worksheets(1)

'you started with 1, so this is overkill, but I like the syntax
'especially when I start my lower bound at something besides 1.

newWks.Range("a1").Resize(UBound(myNumbers) _
- LBound(myNumbers) + 1).Value _
= Application.Transpose(myNumbers)

myFileName = Application.GetSaveAsFilename
If myFileName = False Then
'do nothing, user cancelled.
Else
If Right(myFileName, 1) = "." _
Or LCase(Right(myFileName, 4)) < ".xls" Then
myFileName = myFileName & ".xls"
End If
Application.DisplayAlerts = False
newWks.Parent.SaveAs myFileName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
End If
End If

End Sub



Fred wrote:

I have managed to get the below code working perfect. But for the life
of me I can not figure out how to get the results into a new workbook.

The line "Debug.Print i, myNumbers(i)" sends it to the imediate window
but I need it to go to a new workbook.

Another thing I would like to do is prompt for the file names. These
should be easy but I am stumped!!

Thanks!!
Fred

-----------
Sub compare()
Dim i As Long
Dim myNumbers()
ReDim myNumbers(1 To 1)

With Workbooks("work1.xls").Sheets("Sheet1")
Set rng1 = .Range(.Range("A2"), .Range("A2").End(xlDown))
End With


With Workbooks("work2.xls").Sheets("Sheet1")
Set rng2 = .Range(.Range("A2"), .Range("A2").End(xlDown))
End With

i = 1
For Each cell In rng1
res = Application.Match(cell.Value, rng2, 0)
If IsError(res) Then
myNumbers(i) = cell.Value
i = i + 1
ReDim Preserve myNumbers(1 To i)
End If
Next
ReDim Preserve myNumbers(1 To i - 1)

For i = LBound(myNumbers) To UBound(myNumbers)

Debug.Print i, myNumbers(i)

Next i

End Sub
-------------


--

Dave Peterson