[Solved] Help with Match and Index vba please

[vodada]

Hi all,
I am trying to write a vba code that attempts to index and match between 2 spreadsheet and finally loop through rows and columns to input the match data.
Unfortunately nothings happens and no error by visual basic.
Appreciate if someone can help.

For info. the following are named columns inside the "Database" worksheet.
"Leavecode" , "Employeecode" , "M:AG" , "crew"


Sub LookupLeaveCodes()

'Declare variables

Dim wsData As Worksheet

Dim wsOutput As Worksheet

Dim LastRow As Long

Dim LastCol As Long

Dim i As Long

Dim j As Long

Dim empCode As Variant

Dim leaveCode As Variant



'Set worksheet variables

Set wsData = ThisWorkbook.Worksheets("Database")

Set wsOutput = ThisWorkbook.Worksheets("Output")



'Find last row and column of data in worksheet

LastRow = wsOutput.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

LastCol = wsOutput.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column



'Loop through each row in the specified range

For i = 18 To LastRow

'Loop through each column in the specified range

For j = 25 To LastCol

'Check if the cell is empty

If Not IsEmpty(wsOutput.Cells(i, j).Value) Then

'Get the employee code and leave code for the current cell

empCode = wsOutput.Cells(i, 1).Value

leaveCode = Application.Index(wsData.Range("Leavecode"), _

Application.Match(1, (wsData.Range("Employeecode") = empCode) * (wsData.Range("M:AG") = wsOutput.Cells(17, j).Value) * (wsData.Range("crew") = wsOutput.Cells(14, j).Value), 0))

'Check if a leave code was found

If Not IsError(leaveCode) Then

'Populate the leave code into the current cell

wsOutput.Cells(i, j).Value = leaveCode

Else

'If no leave code was found, clear the current cell

wsOutput.Cells(i, j).ClearContents

End If

End If

Next j

Next i



'Inform user that the code has finished running

MsgBox "Leave code lookup complete.", vbInformation



End Sub

 

[Yousuf Shovon]

Hi all,
I am trying to write a vba code that attempts to index and match between 2 spreadsheet and finally loop through rows and columns to input the match data.
Unfortunately nothings happens and no error by visual basic.
Appreciate if someone can help.

Hello Vodada,

Welcome to our ExcelDemy forum! I understand your VBA code is failing to return any output although the code returns zero error. I looked into it and the code seems to be missing the declaration and initialization of the range variables for the Employeecode, Leavecode, and crew columns in the wsData worksheet. Try declaring the following variables first:

Dim employeeCodeRange As Range
Dim leaveCodeRange As Range
Dim crewRange As Range

Set employeeCodeRange = wsData.Range("Employeecode")
Set leaveCodeRange = wsData.Range("Leavecode")
Set crewRange = wsData.Range("crew")

and also, modify the line that uses these ranges in the Index and Match functions to:

leaveCode = Application.Index(leaveCodeRange, _
    Application.Match(1, (employeeCodeRange = empCode) * (wsData.Range("M:AG") = wsOutput.Cells(17, j).Value) * (crewRange = wsOutput.Cells(14, j).Value), 0))

These modifications should work. Let me know if you still face any issues with a demo dataset. Thank you.

Regards,
Yousuf Shovon

 

[vodada]

Hi Yousuf. Thank you so much for helping. I have tried to make the changes and there is an error. Probably allow me to explain more of what i originally tried to do and also provide the file to explain.

I have created a workbook that has 2 worksheets ("Output" and "Database". I wrote a formula using Xlookup (which you can see in my attached file) that works but slows down the workbook tremendously.
This formula will match Y14, Y17 and A18 ("Output") with L:L, M:AG and D: D ("Database") and return value of K:K ("Database"). Inside "Output" worksheet, I will then drag the formula in cell Y18 across to AG120.
I am hoping the VBA code loops through rows 18 to the last non-empty row in column Y, and loops through columns Y to DD until the last non-empty cell in that row.

 

[Yousuf Shovon]

Hi Yousuf. Thank you so much for helping. I have tried to make the changes and there is an error. Probably allow me to explain more of what i originally tried to do and also provide the file to explain.

I have created a workbook that has 2 worksheets ("Output" and "Database". I wrote a formula using Xlookup (which you can see in my attached file) that works but slows down the workbook tremendously.
This formula will match Y14, Y17 and A18 ("Output") with L:L, M:AG and D: D ("Database") and return value of K:K ("Database"). Inside "Output" worksheet, I will then drag the formula in cell Y18 across to AG120.
I am hoping the VBA code loops through rows 18 to the last non-empty row in column Y, and loops through columns Y to DD until the last non-empty cell in that row.

Hello Vodada,

I'm checking out your dataset, and I understand you want to type the leaves in your database worksheet and then you want them to appear on your output range that's inside your output worksheet. But I'm not sure what the Crew column is all about. Can you help me out with that?

Thank you.

Regards,
Yousuf Shovon

 

[Yousuf Shovon]

I am hoping the VBA code loops through rows 18 to the last non-empty row in column Y, and loops through columns Y to DD until the last non-empty cell in that row.

Hello Vodada,

I think I got this now. The comments in your code show what you want to do. I have used ADODB.Recordset. and it works faster than using formula.

The VBA code:

Public Sub sbRecalc()

    '
    Const Start_Data_Row = 18
    Const Date_Row = 17
    Const Data_Range_ColStart = "Y"
    Const Data_Range_ColEnd = "JP"
    
    Dim Cn As ADODB.Connection
    Dim DBFullName As String
    Dim Cnct As String, strsQL As String
    Dim Rs As ADODB.Recordset
    Dim cmd As New ADODB.Command
    Dim dte As String
    Dim End_Data_Row As Long
    Dim rw As Long, col As Long, column_start As Long, column_end As Long
    
    Dim sht As Worksheet
    
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set sht = Worksheets("Output")
    
    DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    Set Cn = New ADODB.Connection
    Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
    Cn.Open ConnectionString:=Cnct
    
    
    With sht
        
        End_Data_Row = .Cells(Start_Data_Row, 1).End(xlDown).row
        column_start = ColumnLetterToNumber(Data_Range_ColStart)
        column_end = ColumnLetterToNumber(Data_Range_ColEnd)
        
        For rw = Start_Data_Row To End_Data_Row
                
            strsQL = "SELECT T.[Leave Code], Format([Start Date],'yyyymmdd') As d1, " & _
                "Format([End Date],'yyyymmdd') As d2 FROM [Database$] AS T " & _
                "WHERE T.[Employee - Code (Sort By)] = '" & .Range("A" & rw) & "';"
            
            Set Rs = New ADODB.Recordset
            With Rs
                .CursorLocation = adUseClient
                .CursorType = adOpenDynamic
                .LockType = adLockReadOnly
                .ActiveConnection = Cn
                .Open strsQL
                
                If Not .EOF Then
                    Debug.Print Rs("d1"), Rs("d2")
                    For col = column_start To column_end
                        dte = Format(CDate(sht.Cells(Date_Row, col).Value), "yyyymmdd")
                        .Filter = "d1 <= '" & dte & "' AND " & _
                                  "d2 >= '" & dte & "'"
                        If Not .EOF Then
                            sht.Cells(rw, col) = .Fields("Leave Code")
                        Else
                            sht.Cells(rw, col) = ""
                        End If
                        '.Filter = ""
                    Next
                End If
                .Close
            End With
        
        Next
        
    End With
    Set Rs = Nothing
    Cn.Close
    Set Cn = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    MsgBox "Data Added Successfully!"
End Sub

Function ColumnLetterToNumber(ByVal col As String) As Long
    ColumnLetterToNumber = Range(col & "1").column
End Function

Function ColumnNumberToLetter(ByVal col_number As Long) As String
ColumnNumberToLetter = Split(Cells(1, col_number).Address, "$")(1)
End Function

I am attaching the Excel file here. Just click on the Recalculate button to get the desired leave records. Let me know if it works.

Best Regards,
Yousuf Shovon