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,
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
Next lCount End If End With On Error GoTo 0 Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True
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,
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.