Macro needed: list results based on criteria

Hi,

I have a list of companies with the countries they have branches. On a separate sheet is a list of holidays per country.

I need your help in coding a macro that will create a list of all the holidays available for each company. Attached is a workbook as reference with an expected results tab.

Would appreciate any help. ThanksCompany Holidays.xls

nantoy,

Welcome to the forum!
Give this a try:

Sub tgr()
    
    Dim arrList() As Variant
    Dim arrData() As Variant
    ReDim arrData(1 To 3, 1 To Rows.Count)
    Dim ListIndex As Long
    Dim DataIndex As Long
    Dim rngFound As Range
    Dim strFirst As String
    Dim wsCompany As Worksheet
    Dim wsHoliday As Worksheet
    
    Set wsCompany = Sheets("Company List")
    Set wsHoliday = Sheets("Holiday List")
    
    arrList = wsCompany.Range("A2", wsCompany.Cells(Rows.Count, "B").End(xlUp)).Value
    
    For ListIndex = LBound(arrList, 1) To UBound(arrList, 1)
        Set rngFound = wsHoliday.Columns("A").Find(arrList(ListIndex, 2), , , xlWhole)
        If Not rngFound Is Nothing Then
            strFirst = rngFound.Address
            Do While Not rngFound Is Nothing
                DataIndex = DataIndex + 1
                arrData(1, DataIndex) = arrList(ListIndex, 1)
                arrData(2, DataIndex) = arrList(ListIndex, 2)
                arrData(3, DataIndex) = rngFound.Offset(, 1).Value2
                Set rngFound = wsHoliday.Columns("A").Find(arrList(ListIndex, 2), rngFound, , xlWhole)
                If rngFound.Address = strFirst Then Exit Do
            Loop
            Set rngFound = Nothing
        End If
    Next ListIndex
    
    If DataIndex > 0 Then
        ReDim Preserve arrData(1 To 3, 1 To DataIndex)
        With Sheets.Add(After:=Sheets(Sheets.Count))
            .Name = "Company Holiday Results"
            With .Range("A1:C1")
                .Value = Array("COMPANY", "DOMICILE", "DATE")
                .Font.Bold = True
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
            End With
            .Range("A2:C2").Resize(DataIndex).Value = Application.Transpose(arrData)
            Intersect(.UsedRange, .Columns("C")).NumberFormat = "d-mmm-yy"
            .UsedRange.EntireColumn.AutoFit
        End With
    End If
    
End Sub