Searching & Displaying data

Hello there,

I have got two worksheets. One that has got the data and one that displays the reports.

A,B,C,D is data one (I am only going to need A,B & D)
F,G,H is data two.

First of all I would like to join B&A in report sheet with a space so I will have Name Surname.

Then I would like to bring up all values from column D that matching to B&A(if Surname Name is repetitive just bring it as one) name
but as one and bring it to the report sheet in column B.

After that I would like all the values of D that has been matched and displayed in column B (report sheet) with the name from B,A to check if they match with column F and if they do bring the values of column H in report sheet in column C.

Finally in report sheet create an interactive button(or something) with the name Start Report and once that pressed run the macro.

I have attached a sample of the spreadsheet where it has been explained thorough and in report sheet I have type how it would look. (the data i quite big containing approx 30.000 records (a,b,c,d) and approx 2000 records (F,G,H).

Many thanks and I hope I have come to the right section this time.


Kind Regards

How about this

Option Explicit
Sub MakeReport()

Dim WsData As Worksheet, WsReport As Worksheet
Dim NameRng As Range, CurName As Range
Dim JobRng As Range, JobItem As Range
Dim LastRow As Long 'Multiple use
Dim ReportRowCounter As Long
Dim JobRolesStr As String, DescriptionStr As String
Dim FullNameStr As String, CurFullNameStr As String

Set WsData = Sheets("Data")
Set WsReport = Sheets("Report")

'Set all ranges
LastRow = WsData.Cells(WsData.Cells.Rows.Count, "A").End(xlUp).Row
Set NameRng = WsData.Range("A3:A" & LastRow + 1)
LastRow = WsData.Cells(WsData.Cells.Rows.Count, "F").End(xlUp).Row
Set JobRng = WsData.Range("F3:F" & LastRow)

'Clean report
WsReport.Range("A3", WsReport.Cells.SpecialCells(xlCellTypeLastCell)).ClearContents

ReportRowCounter = 3 'Start at row 3.
FullNameStr = ""
For Each CurName In NameRng
  CurFullNameStr = Trim(CurName) & " " & Trim(CurName.Offset(0, 1))
  If CurFullNameStr <> FullNameStr Then 'Unequal to previous
    If FullNameStr <> "" Then
      WsReport.Cells(ReportRowCounter, "A") = FullNameStr
      WsReport.Cells(ReportRowCounter, "B") = Right(JobRolesStr, Len(JobRolesStr) - 3)
      WsReport.Cells(ReportRowCounter, "C") = Right(DescriptionStr, Len(DescriptionStr) - 3)
      ReportRowCounter = ReportRowCounter + 1
    End If
    
    FullNameStr = CurFullNameStr
    JobRolesStr = ""
    DescriptionStr = ""
  End If
  
  JobRolesStr = JobRolesStr & ", " & Chr(10) & CurName.Offset(0, 3)
  
  For Each JobItem In JobRng
    If JobItem = CurName.Offset(0, 3) Then DescriptionStr = DescriptionStr & ", " & Chr(10) & JobItem.Offset(0, 2)
  Next
Next
End Sub

Note that your Namestring are not the same and they contain spaces.

The only think I can think of is when the DescriptionStr Length is 0 and 0-3=-3, that would result in an error.