Hello All,

Im trying to modify a macro I've used in the past for another routine, but
Im not having much luck and could use a little advice.

Im basically looking to perform a Match and Copy.Cell.Offset.Value to
another workbook. The first ActiveWorkbook is referenced as Oldbook. The
Oldbook Row 5 is the column Im looking to match against Workbook 2
(FileName) Row 1 contents. I would like the Macro to evaluate/match each
individual cell value in rows 1 through 200 (Oldbook). If there is a Match
in the FileName book, Id like to write Oldbook values for Row 7, 8, 10 to
rows 2, 3 and 4 in FileName book for that particular match (and continue down
the worksheet).

I know this request might be a bit confusing, but Im hoping this along with
the Macro might shed additional light on the basics of my request.

Thanks for your review and thoughts €“ Roger


Sub fyCompare()
Dim Msg As String
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String

On Error Resume Next
Application.ScreenUpdating = False
Msg = "Unable to find"
Path = "C:\Documents and Settings\Roger\Desktop\"
Filename = "Events.xls"

Oldbook = ActiveWorkbook.Name
Err = 0

If WorkbookIsOpen(Filename) = False Then
Workbooks.Open Filename:=Path & Filename
Else
Workbooks(Filename).Activate
End If
If Err < 0 Then
MsgBox Msg & Path & Filename, vbCritical, "Error"
Exit Sub
End If

Workbooks(Filename).Activate

For r = 1 To 200

'<<<<<< need macro that steps down and
'evaluates each match and writes to offset cells


End If
Next r

Workbooks(Filename).Close
Application.ScreenUpdating = True
End Sub
Private Function WorkbookIsOpen(wbName) As Boolean
' Returns TRUE if the workbook is open
Dim X As Workbook
On Error Resume Next
Set X = Workbooks(wbName)
If Err = 0 Then WorkbookIsOpen = True _
Else: WorkbookIsOpen = False
On Error GoTo 0
End Function

Roger
This is not what you asked for but it is late. The thing is that you can
not copy offsets - you must specify the cell. The following rounds a time
Column A, copies the rounded time to a dynamic list or rather places this
value into another cell.

A lot of code establishes the original range then works on that to to use
cell.offset

Sub wghtdAvg1()
Dim col As Integer, startR As Integer, r As Long
Dim CuProd As Double, CuQty As Long, lr As Long, l As Long
Dim row As Long, i As Long, TCol As Integer, lst, rng As Range

'Set rng = Selection
l = Selection.Rows.Count
r = ActiveCell.row - 1: startR = ActiveCell.row: TCol = ActiveCell.Column
lr = startR + l - 1: col = TCol + 4: row = r

For i = startR To lr
d = Int(Cells(i, TCol) * 1440) * 1 / 1440 'strip seconds from time 2:45:20
to 2:45
Set lst = Range(Cells(startR, col), Cells(row, col))
x = Application.Match(d, lst, 0)
If IsError(x) Then
row = row + 1
Cells(row, col) = d 'enter time in analysis column
CuProd = Cells(i, TCol + 1) * Cells(i, TCol + 2) 'rate * Qty
CuQty = Cells(i, TCol + 2) 'add qty
Cells(row, col + 1) = Cells(i, 2) 'enter qty in analysis
Else 'repeat while time to minute remains the same
CuQty = CuQty + Cells(i, TCol + 2)
CuProd = CuProd + Cells(i, TCol + 1) * Cells(i, TCol + 2)
Cells(row, col + 1) = Application.Round(CuProd / CuQty, 3)
End If
Next i

End Sub

I did this for someone the other day, hope you can make it work for you.
Peter

"Roger" wrote:

Hello All,

Im trying to modify a macro I've used in the past for another routine, but
Im not having much luck and could use a little advice.

Im basically looking to perform a Match and Copy.Cell.Offset.Value to
another workbook. The first ActiveWorkbook is referenced as Oldbook. The
Oldbook Row 5 is the column Im looking to match against Workbook 2
(FileName) Row 1 contents. I would like the Macro to evaluate/match each
individual cell value in rows 1 through 200 (Oldbook). If there is a Match
in the FileName book, Id like to write Oldbook values for Row 7, 8, 10 to
rows 2, 3 and 4 in FileName book for that particular match (and continue down
the worksheet).

I know this request might be a bit confusing, but Im hoping this along with
the Macro might shed additional light on the basics of my request.

Thanks for your review and thoughts €“ Roger


Sub fyCompare()
Dim Msg As String
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String

On Error Resume Next
Application.ScreenUpdating = False
Msg = "Unable to find"
Path = "C:\Documents and Settings\Roger\Desktop\"
Filename = "Events.xls"

Oldbook = ActiveWorkbook.Name
Err = 0

If WorkbookIsOpen(Filename) = False Then
Workbooks.Open Filename:=Path & Filename
Else
Workbooks(Filename).Activate
End If
If Err < 0 Then
MsgBox Msg & Path & Filename, vbCritical, "Error"
Exit Sub
End If

Workbooks(Filename).Activate

For r = 1 To 200

'<<<<<< need macro that steps down and
'evaluates each match and writes to offset cells


End If
Next r

Workbooks(Filename).Close
Application.ScreenUpdating = True
End Sub
Private Function WorkbookIsOpen(wbName) As Boolean
' Returns TRUE if the workbook is open
Dim X As Workbook
On Error Resume Next
Set X = Workbooks(wbName)
If Err = 0 Then WorkbookIsOpen = True _
Else: WorkbookIsOpen = False
On Error GoTo 0
End Function