Help with VBA code

[markster]

Good evening

I have a report of few thousand lines that I'm trying to sort in a better way.

Column E has Customer last name from E7 e.g. Smith

Column K contains reference number date from K7 - the reference number is in the following format: TH_G0_S10_H_13084129

I'm looking for some macro code that will do the following

1. Add the customer last name to the reference number is column K so the reference number will look like this: Smith_TH_G0_S10
2. Remove the H_ number from the reference number column and add to column O so column O will read H_13084129

Any help you can give would be much appreciated.

Thanks in advance.
Mark

 

[mumps]

Will the reference number always have the same number of characters?

 

[markster]

Hi no it won't unfortunately

 

[mumps]

Will the number of underscores always be the same?

 

[markster]

Sorry for the delay - yes the number of underscores will always be the same

 

[mumps]

Try:

Sub SplitValue()
    Application.ScreenUpdating = False
    Dim v As Variant, dic As Object, vName As Variant
    v = Range("E7", Range("E" & Rows.Count).End(xlUp)).Resize(, 7).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v, 1)
        vName = Split(v(i, 7), "_")
        dic.Add Key:=v(i, 1) & "_" & vName(0) & "_" & vName(1) & "_" & vName(2), Item:=vName(3) & "_" & vName(4)
    Next i
    Range("K7").Resize(dic.Count).Value = Application.Transpose(dic.keys)
    Range("O7").Resize(dic.Count).Value = Application.Transpose(dic.items)
End Sub

 

[markster]

Hey mate

Thanks for this. Just tried it and I got an error Runtime error 429 - active X component can't create object. I clicked on the debugger and the bit of the code that was highlighted as an error was Set dic = CreateObject Scripting Dictionary. Any ideas?

Thanks again mate.
Mark

 

[mumps]

Are you using a Mac or a PC?

 

[Fluff]

How about

Sub markster()
   Dim Ary1 As Variant, Ary2 As Variant, Ary3 As Variant
   Dim r As Long
   
   r = Range("E" & Rows.Count).End(xlUp).Row
   Ary1 = Range("E7:E" & r).Value2
   Ary2 = Range("K7:K" & r).Value2
   ReDim Ary3(1 To UBound(Ary1), 1 To 1)
   For r = 1 To UBound(Ary2)
      Ary3(r, 1) = Split(Ary2(r, 1), "_", 4)(3)
      Ary2(r, 1) = Ary1(r, 1) & "_" & Replace(Ary2(r, 1), "_" & Ary3(r, 1), "")
   Next r
   Range("K7").Resize(r - 1).Value = Ary2
   Range("O7").Resize(r - 1).Value = Ary3
End Sub

 

[markster]

Hey mate I'm using a Mac