Hi, rls231,
the code from my post isn´t working for the sheet intended (the moved one) but on the active sheet instead.
You should try this altered code:
Sub EF1030206_2()
'
' paid Macro
' Macro recorded 8/15/2013 by R
'
Dim FindMe As Long
Dim lngWriteTo As Long
Dim wsSummPaid As Worksheet
Dim rngFound As Range
Dim wb As Workbook
Dim wsNewInv As Worksheet 'will be used for teh moved sheet into the summary workbook
Range(ActiveCell.Address).Name = "StartCell"
With Sheets("INDEX")
.Visible = True
Set rngFound = .Cells.Find(What:=CStr(Range("G11").Value), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngFound Is Nothing Then
With rngFound.EntireRow
.Value = .Value
End With
End If
.Visible = False
End With
If rngFound Is Nothing Then
Exit Sub
Else
Set rngFound = Nothing
End If
With Range("B2:J30")
.Value = .Value
End With
Application.GoTo "StartCell"
Set wb = Workbooks.Open(Filename:="C:\Users\Rita\Desktop\Paid Invoices.xlsm", UpdateLinks:=0)
Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.Move After:=wb.Sheets("Summary")
'newly set here
Set wsNewInv = wb.ActiveSheet
Set wsSummPaid = wb.Sheets("Summary")
lngWriteTo = wsSummPaid.Range("A" & Rows.Count).End(xlUp).Row + 1
'I changed from placing a formula to writing values, a paid invoice should not change and be reflectd.
'Please check the ranges of the origins to suit.
With wsSummPaid
.Range("A" & lngWriteTo).Value = wsNewInv.Range("G11").Value
.Range("B" & lngWriteTo).Value = wsNewInv.Range("J12").Value
.Range("C" & lngWriteTo).Value = wsNewInv.Range("G37").Value
.Range("D" & lngWriteTo).Value = wsNewInv.Range("B15").Value
End With
wb.Close True
Sheets("MAIN").Select
Application.DisplayAlerts = True
Set wsNewInv = Nothing
Set wsSummPaid = Nothing
Set wb = Nothing
End Sub
Looking at the codes in your workbook I wonder if the movement of the cursor should trigger an event to calculate (I would expect any choice being made to do so but I may be wrong on that).
As the sheet will be copied over you should take precautions that the code won´t be run again in the collection workbook. One way would be to copy the worksheet into a new workbook, save as macrofree xlsx FileFormat, move the sheet from there with no code into the collection wb and delete the temp file. Or get the name of the workbook and exit the sub if it´s the summray/collection wb:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range
'check the name of the workbook, if it´s the summary stop the code
If ActiveSheet.Parent.Name = "Paid Invoices.xlsm" Then Exit Sub
If Target.Address = "$J$12" And Range("$J$12").Value <> "" Then paid
If Not Intersect(Target, Range("B27:B32")) Is Nothing Then
Range("G27:G32").FormulaR1C1 = "=RC[-3]*RC[-2]"
Range("G33") = "=SUM(G27:G32)"
Range("G37") = "=SUM(G33+G35)"
For Each rngCell In Range("B27:B32")
Select Case rngCell
Case "LABOR - FIRST HOUR"
Range("D27") = 140
Case "LABOR - REGULAR"
Range("D27") = 110
Case "LABOR - AFTER HOURS"
Range("D27") = 175
Case "LABOR - WEEKEND / HOLIDAY"
Range("D27") = 225
End Select
Next rngCell
End If
If Not Intersect(Target, Range("$B$15:$D$18")) Is Nothing Then
Select Case Range("$B$15")
Case "MACY'S EXPENSE PAYABLE | MAINTENANCE OFFICE"
Range("$D$14") = "JOB SITE"
With Range("$D$15").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Job_Site_Addresses"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = False
.ShowError = False
End With
With Range("$D$16")
.Formula = "=VLOOKUP($D$15,'Customer Data'!$U$3:$Z$68,2,FALSE)"
.Value = .Value
End With
With Range("$D$17")
.Formula = "=VLOOKUP($D$15,'Customer Data'!$U$3:$Z$68,6,FALSE)"
.Value = .Value
End With
Case Else
Range("$D$14:$D$19") = ""
End Select
End If
End Sub
Code is untested, I would have used the Change-event instead. But as this code is not part of the original post... 
Regarding the update on the project explorer: when starting your code by moving the cursor strange flickering on my project explorer appeared, one of the reasons I suggested to use a different event to raise the calculation or movement. If a worksheet won´t disappear from the project explorer please close Excel and start again. I´m sorry I don´t have any different answer to that by now.
Ciao,
Holger
LinkBack URL
About LinkBacks
rls231 
Register To Reply
Bookmarks