Cell value to footer

QuestionEdit

QUESTION: I am back to You again. I hope You can help me out this trouble too. I have onefile (a kind of list) open (I use it as Dim PF ActiveWorkbook). In this file I have IDs in column B and numbers for these from 1 to x (as many like the number of IDs) in column A.

I havefiles with identical file names for the IDs and I plan to open each file from CELE folder with the macro. All of these files have the same identical IDs in Range("AA2:AH2") too. I would like to find the corresponding number for the ID from column A in file PF and put it to the wbCodeBook file¡¯s footer and repeat for each file¡­ but nothing comes to the footer with the present code¡­ I hope You can give me some kind of suggestion where and how to change the code below.

I would highly appreciate your help on this matter. Thank You for your kind assistance in advance.

All the best,

attis

The code: Sub FEFIF()

Dim lCount As Long

   Dim wbResults As Workbook
   Dim wbCodeBook As Workbook
   Dim fso As Object
   Dim fldr As Object
   Dim PF As Workbook
    
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Application.EnableEvents = False
    
   On Error Resume Next
   Set PF = ActiveWorkbook
   Set wbCodeBook = ThisWorkbook
    
   With Application.FileSearch
       .NewSearch
       .LookIn = "C:Documents and SettingsattisMy DocumentsCELE\"
       .FileType = msoFileTypeExcelWorkbooks
        
   If .Execute > 0 Then
       For lCount = 1 To .FoundFiles.Count
       Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
      
   Set sh = wbCodeBook.Worksheets("Evaluation Sheet")
   Range("AA2:AH2").Select
   Set cell = sh.ActiveCell

   Set sh2 = PF.ActiveSheet

   Set r = sh2.Range(sh2.Cells(2, "B"), sh2.Cells(sh2.Rows.Count, "B").End(xlUp))
   res = Application.Match(cell.Value, r, 0)
       If Not IsError(res) Then
           Set r1 = r(res)
           With sh.PageSetup
           .Zoom = False
           .RightFooter = r1.Offset(0, -1).Value
           .FitToPagesTall = 1
           .FitToPagesWide = 1
           End With
           Else
           On Error GoTo 0
       End If
  
   Range("D4:F4").Select
   ActiveCell.FormulaR1C1 = "11/05/2010"
   Range("D5:F5").Select
   ActiveCell.FormulaR1C1 = "11/05/2010"
   Rows("5:5").RowHeight = 39.75
   Columns("P:P").ColumnWidth = 3.14
   Columns("T:T").ColumnWidth = 1.14
   Columns("R:R").ColumnWidth = 9.29
   Columns("X:X").ColumnWidth = 1.43
   Columns("AB:AB").ColumnWidth = 2
   

wbResults.Close SaveChanges:=True

       Next lCount
   End If
   End With
    
   On Error GoTo 0
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   Application.EnableEvents = True

End Sub

ANSWER: attis,

your code doesn't make much sense to me. You want to change the footer in the "Evaluation Sheet" of the workbook that contains the code. But I am not sure why you are doing this in a loop through other workbooks.

in you code

 ' open one of the workbooks - this will then be the active 
 ' workbook and hold the activesheet
     Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
  ' set a reference to the Evaluation sheet in the workbook 
  ' that contains the code    
  Set sh = wbCodeBook.Worksheets("Evaluation Sheet")
  ' in the activesheet, the workbook that was just opened, select
  ' Range AA2:AH2  so AA2 will be the activecell 
   Range("AA2:AH2").Select
  ' set a reference to cell AA2 of the Activesheet in the 
  ' workbook just opened
  Set cell = sh.ActiveCell

you then use match to find this value in column B of the sheet that was active in the active workbook when the macro was run.

If the value is found, then res should hold the offset to it in the range R2 which is B2:B last row in the PF activesheet.

if it isn't found, then nothing is put in the footer. If it is found, then the corresponding value in column A is put in the footer.

If you are having problems, then there are many places where this code could lead you astray. It depends greatly on what workbooks and what sheets are active. I all the workbooks an sheets match the expectations of the code and the value in AA2 matches a value in the activesheet of the PF workbook, then I would expect your code to work.

So there really isn't much I can say to change your code since technically it is OK. I would use better references and qualify everything with specific information unless you want it generalized because things will change.

but back to the first question - you loop through workbooks and theoretically would change the footer on the value in AA2 of each workbook you open - but then you don't seem to printout anything - so either you are setting the same value over and over again or I don't know what the point is.

You really need step through your code and see what is going on. I can't debug it from a distance and beyond environmental considerations, syntactically it works.

---------- FOLLOW-UP ----------

QUESTION: I tried this and that but unfortunately could not figure out how this should be solved.

Do You apparently have any idea how to approach to solve this matter?

What I could reach is to get A1 cell value in the footer of the other file but....

I tried then to copy the AA2:AH2 value to the other book to B1 cell and tried to Find the next same value but somehow failed that too... I am in "vicious circle" and cannot go out of it...

I hope You can advise something as a solution. I would really appreciate it and for it.

All the best,

attis

AnswerEdit

attis,

In the code you show, you do

 Set sh = wbCodeBook.Worksheets("Evaluation Sheet")
  Range("AA2:AH2").Select
  Set cell = sh.ActiveCell

  Set sh2 = PF.ActiveSheet

so you select AA2:AH2 but just select it. I don't see where you ever try to copy it anywhere

dim destsh as worksheet set destsh = some workbook some worksheet where you want to copy to Range("AA2:AH2").copy destsh.Cells(destsh.rows.count,"B").end(xlup).offset(1,0)

I really don't know enough about what you are trying to do to offer much else. So I used destsh to show using an object reference to a worksheet to demonstrate how to paste to the next available cell in column B of that "destination" worksheet.