Insert a Character into a Word

[madhuchelliah]

Hello All, i have sentence in D column and range is dynamic, it is mixed of alphanumeric. I need a VBA to look into the words with 7 characters, copy the first character of the word and insert as fifth character. This makes all the 7 character words into 8 character words in the sentence.

Example: Q374 WE333RE333 N123154 QW258 A878968. Expected output is Q374 WE333RE333 N123N154 QW258 A878A968.

Thank you.

 

[Legacy 143009]

Sub test()
  Dim myArr As Variant, tmp As Variant
  myArr = Intersect(Columns("D"), ActiveSheet.UsedRange)
  For i = LBound(myArr) To UBound(myArr)
    tmp = Split(myArr(i, 1), " ")
    For j = LBound(tmp) To UBound(tmp)
      If Len(tmp(j)) = 7 Then
        tmp(j) = Left(tmp(j), 4) & Left(tmp(j), 1) & Right(tmp(j), 3)
      End If
    Next
    myArr(i, 1) = Join(tmp, " ")
  Next
  Intersect(Columns("D"), ActiveSheet.UsedRange).Resize(UBound(myArr)) = myArr
End Sub

 

[Legacy 143009]

A better short hand would be:

Sub test()
  Dim myArr As Variant, tmp As Variant
  With ActiveSheet
  myArr = Intersect(.Columns("D"), .UsedRange)
  For i = LBound(myArr) To UBound(myArr)
    tmp = Split(myArr(i, 1), " ")
    For j = LBound(tmp) To UBound(tmp)
      If Len(tmp(j)) = 7 Then
        tmp(j) = Left(tmp(j), 4) & Left(tmp(j), 1) & Right(tmp(j), 3)
      End If
    Next
    myArr(i, 1) = Join(tmp, " ")
  Next
  Intersect(.Columns("D"), .UsedRange) = myArr
  End With
End Sub

 

[madhuchelliah]

A better short hand would be:

Sub test()
  Dim myArr As Variant, tmp As Variant
  With ActiveSheet
  myArr = Intersect(.Columns("D"), .UsedRange)
  For i = LBound(myArr) To UBound(myArr)
    tmp = Split(myArr(i, 1), " ")
    For j = LBound(tmp) To UBound(tmp)
      If Len(tmp(j)) = 7 Then
        tmp(j) = Left(tmp(j), 4) & Left(tmp(j), 1) & Right(tmp(j), 3)
      End If
    Next
    myArr(i, 1) = Join(tmp, " ")
  Next
  Intersect(.Columns("D"), .UsedRange) = myArr
  End With
End Sub

Hi, it is working as expected. Thanks for your efforts.

 

[Legacy 143009]

Glad it did worked! Thanks for the feedback