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.
|