VBA Search Functionality Issue with Arabic Supplier Names in Excel Help Needed???

[UsmanAli786]

I have a VBA coding in Excel that searches for a supplier or invoice number in a sheet. It returns results when the supplier name is entered in English, but it shows "no match found" when the name is in Arabic.

Sub SearchAndFetchData()
    ' Declare variables
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim searchValue As String
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    Dim found As Boolean
    Dim hyperlinkPath As String
    Dim invoiceNumber As String

    ' Define paths for source and target workbooks
    Dim sourcePath As String
    Dim targetPath As String
   
    sourcePath = "D:\Sharing\Copy of Approved Qoutation record.xlsx"
    targetPath = "C:\Users\DELL\Desktop\TEsst and Trial Folder\Payment Request.xlsm"
   
    ' Get the search value from user input
    searchValue = InputBox("Enter the Supplier Name or Invoice Number to search:", "Search")
   
    ' Check if the user entered a value
    If Trim(searchValue) = "" Then
        MsgBox "Search value cannot be empty.", vbExclamation, "Input Error"
        Exit Sub
    End If
   
    ' Error handling to manage file opening
    On Error GoTo ErrorHandler
   
    ' Open the target workbook
    Set targetWorkbook = Workbooks.Open(targetPath)
    ' Open the source workbook
    Set sourceWorkbook = Workbooks.Open(sourcePath)
   
    ' Set the source and target sheets
    Set sourceSheet = sourceWorkbook.Sheets("APQ-Log aug-Nov2024")
    Set targetSheet = targetWorkbook.Sheets("Summary")
   
    ' Clear previous results in the target sheet
    targetSheet.Rows("5:100").ClearContents ' Adjust range as necessary
   
    ' Find the last row in the source sheet
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    targetRow = 5 ' Start populating data from row 5 in the target sheet
    found = False
   
    ' Loop through the source data to find matches
    For i = 6 To lastRow ' Start from row 6 based on the provided structure
        ' Check if the supplier name or invoice number matches the search value
        If SearchInCell(sourceSheet.Cells(i, 8).Value, searchValue) Or _
           SearchInCell(sourceSheet.Cells(i, 2).Value, searchValue) Then
           
            ' Get the invoice number from Column B
            invoiceNumber = sourceSheet.Cells(i, 2).Value
           
            ' Create the hyperlink path based on the invoice number, ensuring .xlsx is included
            hyperlinkPath = "D:\Sharing\Payables\APQ24\ocT\" & invoiceNumber & ".xlsx"
           
            ' Copy the matching invoice number as a value (not a formula)
            targetSheet.Cells(targetRow, 2).Value = invoiceNumber
           
            ' Create a hyperlink in Column B pointing to the specified path
            targetSheet.Hyperlinks.Add Anchor:=targetSheet.Cells(targetRow, 2), _
                                        Address:=hyperlinkPath, _
                                        TextToDisplay:=invoiceNumber
           
            ' Copy the rest of the row to the target sheet, excluding Column B
            sourceSheet.Rows(i).Copy
            targetSheet.Rows(targetRow).PasteSpecial Paste:=xlPasteValues ' Paste only values
            Application.CutCopyMode = False ' Clear clipboard to avoid the marching ants
           
            targetRow = targetRow + 1 ' Move to the next row in the target sheet
            found = True
        End If
    Next i
   
    ' Inform the user if no matches were found
    If Not found Then
        MsgBox "No matches found for: " & searchValue, vbInformation, "Search Result"
    Else
        MsgBox "Search completed. Results copied to the Summary sheet.", vbInformation, "Search Result"
    End If
   
    ' Close the source workbook without saving changes
    sourceWorkbook.Close SaveChanges:=False
    ' Save the target workbook
    targetWorkbook.Save
   
    ' Clean up
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
    Set sourceWorkbook = Nothing
    Set targetWorkbook = Nothing
    Exit Sub

ErrorHandler:
    ' Handle any errors that occur
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
    If Not sourceWorkbook Is Nothing Then sourceWorkbook.Close SaveChanges:=False
    If Not targetWorkbook Is Nothing Then targetWorkbook.Close SaveChanges:=False
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
    Set sourceWorkbook = Nothing
    Set targetWorkbook = Nothing
End Sub

Function SearchInCell(cellValue As String, searchValue As String) As Boolean
    ' This function checks if the searchValue exists in cellValue
    ' It considers both left-to-right and right-to-left text for Arabic support
    Dim searchResult As Boolean
    searchResult = False
   
    ' Normalize both strings for comparison
    If InStr(1, cellValue, searchValue, vbTextCompare) > 0 Then
        searchResult = True
    ElseIf InStr(1, StrConv(cellValue, vbUnicode), StrConv(searchValue, vbUnicode), vbTextCompare) > 0 Then
        searchResult = True
    End If
   
    SearchInCell = searchResult
End Function

 

[Peter_SSs]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA Search Functionality Issue with Arabic Supplier Names in Excel
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.


Also, when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.