Untruncate

[Hank2]

Need macro, not formula. Workbook A. Sheet 1 Column B starting in Row 7 has a variable number of names with spaces between the rows of names. Each name in the cells has been truncated to 11 spaces by a DB3 program.

Workbook B Sheet 4 has those same names in Column A sheet 4 starting in Row 4 that are not truncated.

I need a macro that will make Wkbk A search in Wkbk B for its similar name by matching the first 11 letters of text (including spacing). When it finds a match I want it to copy that from Wkbk B column A (which is the untruncated name) and the offset column by 1 (column B same row). Then I want it to paste it into Wkbk A Column N & O starting in Row 7. This will line up the truncated and untracated names in the same row.

Example:

Wkbk A Name (B7) Wkbk B Name (A4) Output Wkbk A (N7) (O7)

CAPTAIN VON CAPTAIN VON TRAPP CAPTAIN VON TRAPP 2


The names in the two lists don't necessarily coincide chronologically like this example. Must use match.

 

[DanteAmor]

Try this

Change data in red by your information.

Sub untruncate()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell1 As Range, b As Range, r As Range, largo As Long, celda As String
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    
    Set wb2 = Workbooks("Wkbk B.xlsx")
    Set ws2 = wb2.Sheets("[COLOR=#ff0000]Sheet4[/COLOR]")
    Set r = ws2.Columns("A")
    
    For Each cell1 In ws1.Range("B7", ws1.Range("B" & Rows.Count).End(xlUp))
        largo = Len(cell1.Value)
        Set b = r.Find(cell1.Value, LookAt:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                If LCase(cell1.Value) = LCase(Left(b.Value, largo)) Then
                    ws1.Cells(cell1.Row, "N").Value = b.Value
                    ws1.Cells(cell1.Row, "O").Value = b.Offset(0, 1).Value
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    MsgBox "End"
End Sub

 

[Hank2]

At first I didn't think the code was copying the untracated names, but re copying the truncated names,until I looked closer. Guess I couldn't believe it. Like magic!. Thanks Dante. Good name.

 

[DanteAmor]

Im glad to help you. I appreciate your kind comments.