VBA Code Help

[markster]

Hello

I've been working on automating a report to save me lots of time but different systems display the transaction number in a different way. The majority of the data from different systems has the transaction number in the following format so I want to stick with this format TH_G329_S10_CL6_TF60

TH_G320_S10_J10_CL6_TF60

There's one system where it's quite different and I need it to to convert the transaction number to be in he format shown above. The screen shot below shows what I need:

Any help would be much appreciated. Thanks Mark

 

[DanteAmor]

6T60.G320S10J10_H_14766285
What happens if the dot is missing or the 2 underscores are missing in the original transaction?

Try the following:

Sub Format_transaction_number()
  Dim a As Variant, b As Variant
  Dim p, p1, p2, p3, p4, q
  Dim i As Long, j As Long, k As Long
  Dim m As String, cad As String
  
  a = Range("K6", Range("K" & Rows.Count).End(3)).Value2
  ReDim b(1 To UBound(a), 1 To 2)
  
  For i = 2 To UBound(a)
    k = k + 1
    If InStr(1, a(i, 1), ".") > 0 Then
      p = Split(a(i, 1), ".")
      p1 = p(0)
      q = Split(p(1), "_")
      
      If UBound(q) > 1 Then
        
        p2 = Split(p(1), "_")(0)
        p3 = Split(p(1), "_")(1)
        p4 = Split(p(1), "_")(2)
        
        cad = "TH_" & Left(p2, 1)
        For j = 2 To Len(p2)
          m = Mid(p2, j, 1)
          If m Like "[!0-9]" Then
            cad = cad & "_" & m
          Else
            cad = cad & m
          End If
        Next
        cad = cad & "_CL" & Left(p1, 1) & "_" & Mid(p1, 2, 1) & "F" & Mid(p1, 3)
        b(k, 1) = cad
        b(k, 2) = p3 & "_" & p4
      Else
        'In case there is 2 underscores
      End If
    Else
      'In case there is no dot
    End If
  Next
  Range("R7").Resize(k, 2).Value = b
End Sub

 

[markster]

Works perfectly - thank you so much mate. Have a great afternoon.
Mark

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[markster]

Arghh sorry about this mate I have found something else that needs to be included in the reference too.

Basically, what you've done so far needs to be prefixed with the value in column E as shown above - can you help? No probs if you are too busy.

There is nothing else this really is it.

Cheers
Mark

 

[Rick Rothstein]

If the digit count for each number is always the same (for example, if there are always exactly 3 digits after the letter G in your example, never more, never less... and the same for the digit count for the other numbers), then this more compact macro will also do what you want...

Sub ReformatCode()
  Dim Cell As Range, Arr As Variant
  For Each Cell In Range("K7", Cells(Rows.Count, "K").End(xlUp))
    Arr = Split(Replace(Cell.Value, "_", ".", , 1), ".")
    Cell.Offset(, 7) = Format(Arr(1), """TH_""@@@@\_@@@\_@@@\_") & Format(Arr(0), """CL""@\_@\F@@")
    Cell.Offset(, 8) = Arr(2)
  Next
End Sub

 

[markster]

Thanks for this - unfortunately the number of digits aren't always the same - I just wish they were.

Thanks again.
Mark

 

[DanteAmor]

needs to be prefixed with the value in column E

Try this:

Sub Format_transaction_number()
  Dim a As Variant, b As Variant
  Dim p, p1, p2, p3, p4, q
  Dim i As Long, j As Long, k As Long
  Dim m As String, cad As String
  
  a = Range("E6", Range("K" & Rows.Count).End(3)).Value2
  ReDim b(1 To UBound(a), 1 To 2)
  
  For i = 2 To UBound(a)
    k = k + 1
    If InStr(1, a(i, 7), ".") > 0 Then
      p = Split(a(i, 7), ".")
      p1 = p(0)
      q = Split(p(1), "_")
      
      If UBound(q) > 1 Then
        
        p2 = Split(p(1), "_")(0)
        p3 = Split(p(1), "_")(1)
        p4 = Split(p(1), "_")(2)
        
        cad = "TH_" & Left(p2, 1)
        For j = 2 To Len(p2)
          m = Mid(p2, j, 1)
          If m Like "[!0-9]" Then
            cad = cad & "_" & m
          Else
            cad = cad & m
          End If
        Next
        cad = cad & "_CL" & Left(p1, 1) & "_" & Mid(p1, 2, 1) & "F" & Mid(p1, 3)
        b(k, 1) = a(i, 1) & "_" & cad
        b(k, 2) = p3 & "_" & p4
      Else
        'In case there is 2 underscores
      End If
    Else
      'In case there is no dot
    End If
  Next
  Range("R7").Resize(k, 2).Value = b
End Sub

 

[Rick Rothstein]

Thanks for this - unfortunately the number of digits aren't always the same - I just wish they were.

What about the letters (specifically, the G, S, J and T)... are they always the same?

 

[markster]

Hi Rick - yes but there is also an M that i didn't pick up on
So the reference number could be in either of the following formats:

I'm new to this data and the M ref doesn't appear very often but it does appear.

Thanks
Mark