INDEX MATCH

[Kuba]

I wrote a macro that copies links from coloured cells in a sheet DATABASE in the old release of a given file to a DATABASE (using INDEX / MATCH) in the new file, so the inputs do not need to be re-linked each time a new version of a file comes out.
And the file doesnt work. Any ideas? I am pretty new to VBA, so I am having troubles spotting what is wrong.

Function WorkbookIsOpen(wbname) As Boolean
'Returns TRUE if the workbook is open
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function

Function FileNameOnly(pname) As String
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = Application.PathSeparator Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function

Function Fillcolor(cell) As Integer
Fillcolor = ActiveCell.Interior.ColorIndex
End Function

Sub SimpleUpdate()

' OPEN THE LOCAL FILE WITH LINKS, BUT OLD RELEASE
MsgBox "Please select your Old Release file"
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FMCFilenameOldRel As String
Filt = "Excel Files (*.xls),*.xls," & "All Files (*.*),*.*"
FilterIndex = 1
Title = "Select your Financial Monitoring Cycle file"
FMCFilenameOldRel = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
If FMCFilenameOldRel = "False" Then
MsgBox "No file was selected. Try again later"
Exit Sub
End If

' DETERMINING WHETHER CHOSEN FILE IS ALREADY OPEN AND OPENING IF NECESSARY
If WorkbookIsOpen(FileNameOnly(FMCFilenameOldRel)) = True Then
MsgBox "The File is open. I will copy links from the opened file."
Else
Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = False
Workbooks.Open (FMCFilenameOldRel)
End If


' START TRANSFERRING THE DATA
Dim aletters, bletters, db As Range
Dim k, l As Integer

'IS THE PROBLEM HERE?
Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("j5:j4000").Name = "aletters"
Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("j1:bq1").Name = "bletters"
Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("j5:bq4000").Name = "db"

For l = 5 To 4000
For k = 10 To 70

ThisWorkbook.Activate
Cells(l, k).Activate
If Fillcolor(ActiveCell) = "-4142" Then


Else
Cells(l, k).Formula = _
Application.Index(Range("db"), _ 'WHAT IS WRONG HERE?
Application.Match(Cells(l, 9).Value, Range("bletters"), False), _
Application.Match(Cells(1, k).Value, Range("bletters"), False)).Formula
End If

Next k
Next l

End Sub

 

[Kuba]

i managed to get this macro working on a small database (6 by 10 instead of 3000 by 70), but it breaks down on a large scale file. "Method RANGE of object _GLOBAL failed".
I looked at the next post - about similar type of error reported, but i have no clue what i can qualify in the statement...

Cells(l, k).Formula = _
Application.Index(Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("i2:bq2972"), _
Application.Match(Cells(l, 9).Value, Range("aletters"), False), _
Application.Match(Cells(1, k).Value, Range("bletters"), False)).Formula

I am as confused as a baby in a topless bar

 

[Dave Peterson]

Are you trying to return a value to Cells(1,k) or the formula "=index(...)"?

If a value, maybe:

With Workbooks(filenameonly(FMCFilenameOldRel).Worksheets("database"))
ActiveSheet.Cells(l, k).Value = _
Application.Index(.Range("i2:bq2972"), _
Application.Match(ActiveSheet.Cells(l, 9).Value, _
.Range("aletters"), False), _
Application.Match(ActiveSheet.Cells(1, k).Value, _
.Range("bletters"), False))
End With

But I wasn't sure what the cells referred to, so I chose the activesheet???