Home |
Search |
Today's Posts |
|
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Analysis of measured test results by INTERVAL (variable) | Excel Discussion (Misc queries) | |||
provide simultaneous results for a range of a particular variable | Excel Discussion (Misc queries) | |||
Record macro and obtain variable range results? | Excel Discussion (Misc queries) | |||
Define drop-down results that are variable and dependent upon the. | Excel Discussion (Misc queries) | |||
Variable for workbook name | Excel Programming |