VBA find and replace using array from table - Issues with multiline text

Greeb1979 · May 27th 2021

Hi All, I'm a relative beginner at VBA and have been grappling with this issue for a while now. I've tried various methods and feel like i'm finally getting somewhere, so any help would be greatly appreciated.

I've been using the following code (Posted by TheSilkCode on another site I wont name), to find a part number from a table and replace it with the part number and description.

The Code works fine where the description is a single line however when multiple lines of text are used I get Run-time error '13': Type mismatch.

As the description is taken from another spreadsheet I don't control, I can't change the format of the source to be on a single line. So I'm looking for help to make the code work with multiline text.

Example-

If PN001 is replaced with

PN001 ABC, DEF

the code works fine..

If PN001 is replaced with

PN001:

ABC

DEF

Then the Run-Time error'13' occurs

Code:

Code

Public Sub demoCode_v2()
Dim tableRange As Range
Dim myArray() As Variant
Dim rowCounter As Long
Dim targetRange As Range

'Create an Array out of the Table's Data
Set tableRange = ThisWorkbook.Sheets("EPM Find Replace List").ListObjects("Table1").DataBodyRange
myArray = tableRange

'Select target range
Set targetRange = Application.InputBox("Select target range:", Type:=8)

'Loop through each item in lookup table
For rowCounter = LBound(myArray, 1) To UBound(myArray, 1)    'Replace any cells in target range that contain whats in the first column of the lookup table, with whats in the 2nd column..    targetRange.Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next

End Sub

Display More

**KjBox** · May 28th 2021

Attach sample workbooks (your workbook and the description workbook)

Greeb1979 · May 28th 2021

Hi KjBox, I can't upload the original file so I've created an example (Attached). After creating the example I found that multiple lines of text worked fine. So after much experimentation trying to discover what the issue is, it appears that it relates to the number of characters rather than multiple lines. It just happens that the multiple lines in the original document exceeded the number of characters, leading me down the wrong path.

In the attached example on worksheet "Model" model no's are listed in column A, with part numbers listed in column E, I've added a few more columns shown as other info to make it more representative of the original document.

On worksheet "Array Table" the part numbers are listed in column A, with the Part number and example description in column B.

The Macro is activated by the button on the top left of the Model Worksheet shown as "Update Part Number".

The Macro scans down the column A of the table array finds the part number in the Model Worksheet and replaces the part number with part number and description from Column B of the Array table.

As the Macro reaches PN015 on the array table the Macro halts with Run-Time Error '13' Type Mismatch, I believe this is due to the number of characters.

So I guess my question has changed to how can I make the Macro work with more characters?

**KjBox** · May 28th 2021

Try the attached.

I think the Find method you were using has a limit of 255 characters, the new code assigns all data to arrays and works with those arrays before writing the modified array x back to the worksheet and thus updating it.

Code now assigned to the button:

Code

Option Explicit

Sub AddPNDescription()
    Dim x, y, yy, z, i As Long, ii As Long, iii As Long, s As String
    
    Const PNCol As Long = 5 'Change to actual Part Number column
    
    y = Sheet2.ListObjects(1).DataBodyRange
    yy = Sheet2.ListObjects(1).DataBodyRange.Columns(1)
    
    With Sheet1.[a3].CurrentRegion
        x = .Value
        For i = 2 To UBound(x, 1)
            s = ""
            z = Split(x(i, PNCol), vbLf)
            For ii = LBound(z) To UBound(z)
                If Not IsError(Application.Match(Trim(z(ii)), yy, 0)) Then
                    iii = Application.Match(Trim(z(ii)), yy, 0)
                    If s = "" Then s = y(iii, 2) Else s = s & vbLf & y(iii, 2)
                ElseIf z(ii) <> "" Then
                    MsgBox "Part number " & z(ii) & " not found", 64, "Missing Description"
                End If
                x(i, PNCol) = s
            Next
        Next
            .Value = x
            .Rows.AutoFit
    End With
    
End Sub

Display More

Note I have added an error trap and a message in the event of a description not being found for a part number in sheet 1.

I have indicated in the code where you need to change the Column number if it is anything other than 5 (Column E) in your actual file.

Greeb1979 · May 31st 2021

Hi KjBox, thanks so much for your help, I Haven't had chance to have a play around with it until today. Unfortunately I found when I add a new line or push the button again, multiple error messages pop up and it blanks must of the cells in the column. I understood enough of the original code to be able to resolve issues, but unfortunately your code is far beyond my understanding. If you have any suggestions i'd be grateful.

**KjBox** · May 31st 2021

Attach the workbook where the errors occurred

Greeb1979 · May 31st 2021

Hi KjBox, I'm using the new code example you sent, when I add a new line to the spreadsheet the first part number automatically updates without the button press, however any subsequent part numbers do not populate. If I press the button again then multiple error messages occur from the Msgbox in the code, after closing these error Messages the column is mostly left blank, on occasion adding a new line also seems to trigger the Macro, although I can't seem to get that to occur at the moment.

**KjBox** · May 31st 2021

The errors occurred when the button was clicked again after adding new data because the code was trying to match Part Number + Description with Part Number in the Table on Array Table sheet.

Try this, it will ignore Part Numbers that have already been updated with a Description.

Code

Sub AddPNDescription()
    Dim x, y, yy, z, i As Long, ii As Long, iii As Long, s As String
    
    Const PNCol As Long = 5 'Change to actual Part Number column
    
    y = Sheet2.ListObjects(1).DataBodyRange
    yy = Sheet2.ListObjects(1).DataBodyRange.Columns(1)
    
    With Sheet1.[a3].CurrentRegion
        x = .Value
        For i = 2 To UBound(x, 1)
            s = ""
            z = Split(x(i, PNCol), vbLf)
            For ii = LBound(z) To UBound(z)
                If Len(Trim(z(ii))) = 5 Then
                    If Not IsError(Application.Match(Trim(z(ii)), yy, 0)) Then
                        iii = Application.Match(Trim(z(ii)), yy, 0)
                        If s = "" Then s = y(iii, 2) Else s = s & vbLf & y(iii, 2)
                    ElseIf z(ii) <> "" Then
                        MsgBox "Part number " & z(ii) & " not found", 64, "Missing Description"
                    End If
                    x(i, PNCol) = s
                End If
            Next
        Next
            .Value = x
            .Rows.AutoFit
    End With
    
End Sub

Display More

Greeb1979 · May 31st 2021

Hi KJBox, thanks so much. That works great, thanks for all your help.

**KjBox** · May 31st 2021

You're welcome

Greeb1979 · Jun 1st 2021

Hi KjBox, I've come across an issue when I use the code on the actual spreadsheet. The actual Part numbers can differ in length i.e PN001 PN123456 which I didn't show on my example.

I believe the issue is on line 15

" If Len(Trim(z(ii))) = 8 Then" - I changed the value to 8 to allow for the longer part numbers, however after doing this shorter part numbers in the same cell now get deleted.

Is there a way to set this to a range i.e. between 4 and 8?

Thanks again.

**KjBox** · Jun 1st 2021

Try

Code

If Len(Trim(z(ii))) > 3 And Len(Trim(z(ii))) < 9 Then

VBA find and replace using array from table - Issues with multiline text

Participate now!

Share

Tags