michaelg1040
New Member
- Joined
- Jun 23, 2006
- Messages
- 44
I've got the following code:
Sub UpdateReport()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim Rng As Range
Dim wbMaster As Workbook
Dim wsMaster As Worksheet
Dim Cell As Range
Dim Target As Range
Dim r As Long
Set wbSource = Workbooks("DevProgrammeReport.xls")
Set wsSource = wbSource.Worksheets("DevProgrammeReport")
With wsSource
Set Rng = .Range("D2:D" & .Range("D" & .Rows.Count).End(xlUp).Row)
End With
Set wbMaster = Workbooks("CO-OP PM Tracker 2010 (2 with pm allocation).xls")
Set wsMaster = wbMaster.Worksheets("CO-OP REFIT PM TRACKER")
For Each Cell In Rng
With wsMaster
With .Columns("B")
Set Target = Nothing
Set Target = .Find(What:=Cell.Value, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
If Not Target Is Nothing Then
r = Target.Row
Else
r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
.Range("A" & r).Value = Cell.EntireRow.Range("C" & 1).Value
.Range("B" & r).Value = Cell.EntireRow.Range("D" & 1).Value
.Range("C" & r).Value = Cell.EntireRow.Range("I" & 1).Value
.Range("D" & r).Value = Cell.EntireRow.Range("J" & 1).Value
.Range("E" & r).Value = Cell.EntireRow.Range("M" & 1).Value
.Range("F" & r).Value = Cell.EntireRow.Range("N" & 1).Value
.Range("I" & r).Value = Cell.EntireRow.Range("P" & 1).Value
.Range("J" & r).Value = Cell.EntireRow.Range("Q" & 1).Value
End With
Next Cell
End Sub
This code compares 2 workbooks - a source workbook which is updated by my client each week and sent to me, and a master tracker (this is where the code sits).
The code looks at the source workbook and updates the master tracker with any changes or additions but I also need it to delete rows from the master tracker if the project is no longer on the source workbook.
Please help!
Sub UpdateReport()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim Rng As Range
Dim wbMaster As Workbook
Dim wsMaster As Worksheet
Dim Cell As Range
Dim Target As Range
Dim r As Long
Set wbSource = Workbooks("DevProgrammeReport.xls")
Set wsSource = wbSource.Worksheets("DevProgrammeReport")
With wsSource
Set Rng = .Range("D2:D" & .Range("D" & .Rows.Count).End(xlUp).Row)
End With
Set wbMaster = Workbooks("CO-OP PM Tracker 2010 (2 with pm allocation).xls")
Set wsMaster = wbMaster.Worksheets("CO-OP REFIT PM TRACKER")
For Each Cell In Rng
With wsMaster
With .Columns("B")
Set Target = Nothing
Set Target = .Find(What:=Cell.Value, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
If Not Target Is Nothing Then
r = Target.Row
Else
r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
.Range("A" & r).Value = Cell.EntireRow.Range("C" & 1).Value
.Range("B" & r).Value = Cell.EntireRow.Range("D" & 1).Value
.Range("C" & r).Value = Cell.EntireRow.Range("I" & 1).Value
.Range("D" & r).Value = Cell.EntireRow.Range("J" & 1).Value
.Range("E" & r).Value = Cell.EntireRow.Range("M" & 1).Value
.Range("F" & r).Value = Cell.EntireRow.Range("N" & 1).Value
.Range("I" & r).Value = Cell.EntireRow.Range("P" & 1).Value
.Range("J" & r).Value = Cell.EntireRow.Range("Q" & 1).Value
End With
Next Cell
End Sub
This code compares 2 workbooks - a source workbook which is updated by my client each week and sent to me, and a master tracker (this is where the code sits).
The code looks at the source workbook and updates the master tracker with any changes or additions but I also need it to delete rows from the master tracker if the project is no longer on the source workbook.
Please help!