View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.misc
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Merging the Changes from One Excel Document into another

I found the problem. The x's where going into the wrong workbook. I added a
check to give warning message if no differences were found

Sub GetNewPOs()

Set OldSht = ThisWorkbook.Sheets(1)
LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

FileToOpen = Application _
.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
Title:="select workbook with new Po's")
If FileToOpen = False Then
MsgBox ("Cannot Open file - Exiting Macro")
Exit Sub
End If

Set Newbk = Workbooks.Open(Filename:=FileToOpen, ReadOnly:=True)

With Newbk.Sheets(1)
RowCount = 2
Do While .Range("D" & RowCount) < ""
PO = .Range("D" & RowCount)

With OldSht
'check if PO exists
Set c = .Columns("D").Find(what:=PO, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If c Is Nothing Then
'put X in column IV if PO should be move to old workbook
.Range("IV" & RowCount) = "X"

End If

RowCount = RowCount + 1
Loop

'copy rows with X's in column IV
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'check if there are x's to prevent errors
Set c = .Columns("IV:IV").Find(what:="X", _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("No difference found in new workbook")
Else
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
Set NewPOs = .Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible)
NewPO.Copy Destination:=OldSht.Rows(NewRow)
'delete the X's in Column IV
OldSht.Columns("IV").Delete
End If
End With

Newbk.Close savechanges:=False
End Sub


"jwags" wrote:

Thank you very much for the script. I pasted it into the workbook and
was able to get it working until the line .Columns
("IV:IV").AutoFilter. I get an run time error message at this point
and it goes no further. Is it a problem with the way I have it
setup? I looked in column IV and there are no X's in the column.