View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Automatic Data Management


There are two macros in the code I sent. the 1st one is intended for a new
data and the second is for updating an existing workbook. The 2nd should
work in either case.

You should be running the 2nd macro. I made one change to the 1st macro to
clear all cells in destination sheet assuming you want to add all data. I
changed the 2nd macro to test for N/A in columns A and F.

Sub CreateMaster()

SourceToOpen = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Source file")
If SourceToOpen = False Then
MsgBox ("Cannot Open file - Exinting Macro")
Exit Sub
End If

DestToOpen = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Destination file")
If DestToOpen = False Then
MsgBox ("Cannot Open file - Exinting Macro")
Exit Sub
End If


Set Source = Workbooks.Open(Filename:=SourceToOpen)
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")

Set Dest = Workbooks.Open(Filename:=DestToOpen)
'Set Dest = ThisWorkbook
Set DestSht = Dest.Sheets("WPS Detail Dates")

With DestSht
.Cells.ClearContents
SourceSht.Columns("C:C").Copy _
Destination:=.Columns("C:C")
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row

.Range("C1:C" & Lastrow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), _
Unique:=True

'delete temporay column C
.Columns("C").Delete

.Range("A1") = "SALES"
.Range("B1") = "ID"
.Range("C1") = "Employee"
.Range("D1") = "Hire Date"
.Range("E1") = "Manager"
.Range("F1") = "Reg"
.Range("G1") = "Title"

Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
ID = .Range("B" & RowCount)

With SourceSht
Set c = .Columns("C").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find ID : " & ID)
Else
Sales = "N/A"
Reg = "N/A"
Employee = .Range("A" & c.Row)
HireDate = .Range("D" & c.Row)
Title = .Range("E" & c.Row)
Manager = .Range("G" & c.Row)
End If
End With

If Not c Is Nothing Then
.Range("A" & RowCount) = Sales
.Range("C" & RowCount) = Employee
.Range("D" & RowCount) = HireDate
.Range("E" & RowCount) = Manager
.Range("F" & RowCount) = Reg
.Range("G" & RowCount) = Title
Else
MsgBox ("Error : Count not find ID : " & ID)
End If
Next RowCount
End With

End Sub

Sub UpdateMaster()

SourceToOpen = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Source file")
If SourceToOpen = False Then
MsgBox ("Cannot Open file - Exinting Macro")
Exit Sub
End If

DestToOpen = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Destination file")
If DestToOpen = False Then
MsgBox ("Cannot Open file - Exinting Macro")
Exit Sub
End If


Set Source = Workbooks.Open(Filename:=SourceToOpen)
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")

Set Dest = Workbooks.Open(Filename:=DestToOpen)
'Set Dest = ThisWorkbook
Set DestSht = Dest.Sheets("WPS Detail Dates")

With DestSht
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = Lastrow + 1
End With


With SourceSht

Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
ID = .Range("C" & RowCount)
Employee = .Range("A" & RowCount)
HireDate = .Range("D" & RowCount)
Title = .Range("E" & RowCount)
Manager = .Range("G" & RowCount)

With DestSht
Set c = .Columns("B").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
DataRow = NewRow
NewRow = NewRow + 1
.Range("B" & DataRow) = ID

.Range("C" & DataRow) = Employee
.Range("D" & DataRow) = HireDate
.Range("E" & DataRow) = Manager
.Range("F" & DataRow) = Reg

Else
DataRow = c.Row
If .Range("A" & DataRow) < "N/A" And _
.Range("F" & DataRow) < "N/A" Then

.Range("C" & DataRow) = Employee
.Range("D" & DataRow) = HireDate
.Range("E" & DataRow) = Manager
.Range("G" & DataRow) = Title
End If
End If

End With
Next RowCount
End With

End Sub