Index / Match - desperation

K

Kuba

Hello to all,

Yet another wondering, as I fight my way through the INDEX / MATCH formulas.
THe macro copies (or rather aims to copy) the formula from coloured cells of one table, to the same relative position on another table.
When I use the following formula (as suggested yesterday)

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

ThisWorkbook.Activate
Worksheets("DATABASE").Cells(l, k).Select
If Fillcolor(Cells(l, k)) = "-4142" Then
Else
With Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE")
ActiveSheet.Cells(l, k).Value = _
Application.Index(.Range("db"), _
Application.Match(ActiveSheet.Cells(l, 9).Value, .Range("aletters"), False), k).Formula
End With
...... I still get the error message - but ONLY after it runs k up to 61.

If I get rid of the MATCH bit altogether (i.e. input row and column number from which to copy), the file runs fine (i.e. the INDEX bit seems to be ok).

Is it sth to do with the fact that I use a custom function FileNameOnly? How else could I reference easily between the two files: one that contains the macro and where the links (formulas) are copied to, and another one with the links to be copied from.

Merry Christmas, I hope Santa is good to everyone this year

Kuba

full code below:
Option Explicit
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 Financial Monitoring Cycle 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

Application.Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("i5:i2972").Name = "aletters"
Application.Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("j1:bq1").Name = "bletters"
Application.Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE").Range("j5:bq2972").Name = "db"

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

ThisWorkbook.Activate
Worksheets("DATABASE").Cells(l, k).Select
If Fillcolor(Cells(l, k)) = "-4142" Then
Else
With Workbooks(FileNameOnly(FMCFilenameOldRel)).Worksheets("DATABASE")
ActiveSheet.Cells(l, k).Value = _
Application.Index(.Range("db"), _
Application.Match(ActiveSheet.Cells(l, 9).Value, .Range("aletters"), False), k).Formula
End With

End If

Next k
Next l

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top