Converting VBA Macro to Basic LibreOffice Macro

[Flds]

Hello,
I need to know, how to convert the following VBA macro/function from Excel (below). When I opened it in LibreOffice this is what it displayed and I need to convert this script. Would like to use it with LibreOffice.

Your help would be appreciated. Thanks

Below is the VBA Script:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
                            Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
Dim i As Long, j As Long
With compareRange.Parent
Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
 End With
If compareRange Is Nothing Then Exit Function
If stringsRange Is Nothing Then Set stringsRange = compareRange
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                            stringsRange.Column - compareRange.Column)
For i = 1 To compareRange.Rows.Count
    For j = 1 To compareRange.Columns.Count
        If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
            If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
            End If
        End If
    Next j
Next i
ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End Function

Hoping to get a response

[JohnSUN]

Welcome @Flds !
Tell me please, did you write this yourself? Then you can probably explain the purpose of these lines:

@Flds

With compareRange.Parent
Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
 End With

The thing is that without these three lines the macro works fine. You just need to specify the ranges exactly, and not rely on the fact that this function will work even with incorrect data.

[karolus]

Additionally to @JohnSUN comment:
Instead this VBA-garbage, try native Calc-Functions in your Spreadsheet like:

=TEXTJOIN( delimiter ; 0 ; UNIQUE( FILTER(…)))

[Flds]

Hi JohnSUN,
Thank you for your quick response.
No, I did not write this script myself. I do not know VBA. I got help years ago.
The purpose of this was. I had created an Excel sheet, where I entered the birthdays and anniversaries of friends and family. So when I open this file the name of the persons birthday or anniversary appears on the top of the spreadsheet.
The spread sheet has the following columns. Name, Last Name, DoB, etc.

John, the 3 lines you sent, where should I insert them and do I have to delete any lines on the existing script I sent. Your help would be appreciated.
Thanks

[Flds]

Hi Karolus,
Thanks for your response. I do not understand what this line is. Do I need to inserte it in the script I sent.

Thanks

[JohnSUN]

If you don’t care what is written in the code, then I suggest adding this function to your macros:

Function ConcatIf2(aCompare As Variant, xCriteria As Variant, Optional aStrings As Variant, _
                            Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
Dim i As Long, j As Long, k As Long, m As Long, iRows As Long, iCols As Long 
Dim aResult() As String, bNotFound As Boolean 
	If IsMissing(NoDuplicates) Then NoDuplicates = False
	If IsMissing(Delimiter) Then Delimiter = ""
	If IsMissing(aStrings) Then aStrings = aCompare
	If UBound(aCompare,1) < UBound(aStrings,1) Then iRows = UBound(aCompare,1) Else iRows = UBound(aStrings,1) 
	If UBound(aCompare,2) < UBound(aStrings,2) Then iCols = UBound(aCompare,2) Else iCols = UBound(aStrings,2) 
	ReDim aResult(iRows*iCols)
	m = -1
	For i = 1 To iRows
	    For j = 1 To iCols
	        If (aCompare(i, j) = xCriteria) Then
        		m = m + 1
        		aResult(m) = aStrings(i, j)
        	EndIf 
	    Next j
	Next i
	If m Then
		ReDim Preserve aResult(0 to m)
       	If NoDuplicates Then
			k = 0
			For i = 1 To m
	       		bNotFound = True
        		For j = 0 To k
        			If aResult(i) = aResult(j) Then 
        				bNotFound = False
        				Exit For 
        			EndIf 
        		Next j
        		If bNotFound Then
        			k = k + 1
        			aResult(k) = aResult(i)
        		EndIf 
        	Next i
			ReDim Preserve aResult(k)
		EndIf 
		ConcatIf2 = Join(aResult, Delimiter)
	Else 
		ConcatIf2 = ""
	EndIf 
End Function

This code is a little longer than your original macro, but will run faster.

[karolus]

@Flds

Do I need to inserte it in the script I sent.

NO, you should use it directly in the sheet with your customized arguments.

• or
  ⇒ Data ⇒ Filter ⇒ …