Macro to convert specific text and format specific text within a string

I have some data pulled from a SQL database that we put into excel to do some reporting. (We don't have direct access to the SQL data so we can't write any reports there.)

A couple of the columns/fields have information that looks like the following examples:

NY DEC2012-30.0000 USC/LB
LN NOV2012+440.0000 USD/MT
NY DEC2012+29.0000 USC/LB
NY DEC2012+26.5000 USC/LB
NY DEC2012+51.0000 USC/LB
LN NOV2012+440.0000 USD/MT
LN JAN2013+500.0000 USD/MT


(Each of these is in a separate cell with in that particular column)

I need to do the following things with the data in these columns.

1.) If the cell contains USC/LB, then do nothing at all.
2.) if the cell contains USD/MT then do the following:
a.) BOLD the 1st two characters (almost always it will be the letters "LN")
b.) Convert the value after the "+" or "-" (I'll call it AMT here) by doing the following calculation:
i.) AMT divided by 22.046 (Example 400/22.046 (rounded to the 2nd decimal place, but showing 4 total decimal places) which would be 19.9600)
ii.) make the results of the calculation to appear in red text (just the number, nothing else)
c.) Change the USD/MT to USC/LB and make those letters bold.

>> So the above data should look like the following when run:
NY DEC2012-30.0000 USC/LB
LN NOV2012+19.9600 USC/LB
NY DEC2012+29.0000 USC/LB
NY DEC2012+26.5000 USC/LB
NY DEC2012+51.0000 USC/LB
LN NOV2012+19.9600 USC/LB
LN JAN2013-22.6800 USC/LB
The file will vary in length each time we get it (sometimes as many as 3000 lines), and those strings will appear in two columns with the headings:
purch_valn_string
sales_valn_string

I'm hoping to create a macro (that possibly would be called by an other macro later as we develop this) that will do the formatting quickly.

Any suggestions?

Thank you in advance

Try this:

Sub test()

    ' Varables for workbook and worksheet
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    ' Set range to process
    ' You'll need to adjust the columns to meet your needs
    Dim lastrow As Long
    lastrow = ws.Range("A1048576").End(xlUp).Row
    Dim rng As Range
    Set rng = ws.Range("A1:A" & lastrow)
    
    
    Dim cl As Variant ' Used to handle cell value
    Dim strAMT As String ' Used to capture original amount for text operations
    
    Dim dblOrig As Variant
    Dim dblNew As Variant
    Dim splitter As String

    Dim lngSTART As Long
    Dim lngOrigLEN As Long
    Dim lngNewLEN As Long

    ' For each cell in the range
    For Each cl In rng
        
        Select Case Right(cl.Value, 6)
            Case "USC/LB"
                ' Do Nothing
            Case "USD/MT"
                
                ' Perform Caluculation
                Select Case True
                    Case (InStr(cl.Value, "+")) > 0
                        splitter = "+"
                        lngSTART = InStr(cl.Value, "+") + 1
                    Case (InStr(cl.Value, "-")) > 0
                        splitter = "-"
                        lngSTART = InStr(cl.Value, "-") + 1
                End Select
                
                ' Get amount value
                strAMT = Split(Split(cl.Value, " ")(1), splitter)(1)
                dblOrig = CDbl(strAMT)
                lngOrigLEN = Len(dblOrig)
                ' Divide and round
                dblNew = Round(dblOrig / 22.046, 2)
                ' Convert back to string and append 0's
                dblNew = CStr(dblNew) & "00"
                lngNewLEN = Len(dblNew)
                
                ' Replace Text
                cl.Value = Replace(Replace(cl.Value, strAMT, dblNew), "USD/MT", "USC/LB")
                
            
                
                ' Bolds and colors must be applied last or will affect whole cell
                ' Bold first two characters
                With cl.Characters(start:=1, Length:=2)
                    .Font.Bold = True
                End With
                
                ' Red
                With cl.Characters(start:=lngSTART, Length:=lngNewLEN)
                    .Font.ColorIndex = 3
                End With
                
               ' Bold USD/...
                With cl.Characters(start:=Len(cl.Value) - 6, Length:=6)
                    .Font.Bold = True
                End With
                
                
        End Select
    Next cl
    
    Set ws = Nothing
    Set wb = Nothing
    
    
End Sub

WOW!! Very nice,....

It's almost perfect.

Only problem I encountered (and I omitted it in my original post - My Bad!) is that on occasion sometime there isn't a value in a cell or more) in the columns in question. A few cells in the column are either empty, or for some reason just have a few spaces (so the cell appears empty.)

When the Macro encounters a cell that doesn't have anything in it, it stops and displays "Run-time error '13' Type mismatch". When you debug, it highlights "Select Case Right(cl.value, 6)

I'm reviewing your code to wrap my head around it (By the way,.. AWESOME work), to see if I can adjust it to deal with the empty cells. However, if you can point me in the right direction, I will be your BIGGEST fan!!

Thank you so much gyclone!!!!!!!!!!

Oh, yeah, sorry about that. Try this instead (I'll explain the changes below):

Sub test()

    ' Varables for workbook and worksheet
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    ' Set range to process
    ' You'll need to adjust the columns to meet your needs
    Dim lastrow As Long
    lastrow = ws.Range("A1048576").End(xlUp).Row
    Dim rng As Range
    Set rng = ws.Range("A1:A" & lastrow)
    
    
    Dim cl As Variant ' Used to handle cell value
    Dim strAMT As String ' Used to capture original amount for text operations
    
    Dim dblOrig As Variant
    Dim dblNew As Variant
    Dim splitter As String

    Dim lngSTART As Long
    Dim lngOrigLEN As Long
    Dim lngNewLEN As Long

    ' For each cell in the range
    For Each cl In rng

        If Not cl.Value = "" Then ' NEW
            
            Select Case Right(cl.Value, 6)
                Case "USC/LB"
                    ' Do Nothing
                Case "USD/MT"
                    
                    ' Perform Caluculation
                    Select Case True
                        Case (InStr(cl.Value, "+")) > 0
                            splitter = "+"
                            lngSTART = InStr(cl.Value, "+") + 1
                        Case (InStr(cl.Value, "-")) > 0
                            splitter = "-"
                            lngSTART = InStr(cl.Value, "-") + 1
                    End Select
                    
                    ' Get amount value
                    strAMT = Split(Split(cl.Value, " ")(1), splitter)(1)
                    dblOrig = CDbl(strAMT)
                    lngOrigLEN = Len(dblOrig)
                    ' Divide and round
                    dblNew = Round(dblOrig / 22.046, 2)
                    ' Convert back to string and append 0's
                    dblNew = CStr(dblNew) & "00"
                    lngNewLEN = Len(dblNew)
                    
                    ' Replace Text
                    cl.Value = Replace(Replace(cl.Value, strAMT, dblNew), "USD/MT", "USC/LB")
                    
                
                    
                    ' Bolds and colors must be applied last or will affect whole cell
                    ' Bold first two characters
                    With cl.Characters(start:=1, Length:=2)
                        .Font.Bold = True
                    End With
                    
                    ' Red
                    With cl.Characters(start:=lngSTART, Length:=lngNewLEN)
                        .Font.ColorIndex = 3
                    End With
                    
                   ' Bold USD/...
                    With cl.Characters(start:=Len(cl.Value) - 6, Length:=6)
                        .Font.Bold = True
                    End With
                    
                    
            End Select
        End If ' NEW
    Next cl
    
    Set ws = Nothing
    Set wb = Nothing
    
    
End Sub

So, all I did was add a check for empty cells right inside the for/each loop. If the cell is empty, it just moves to the next cell.

for each cl in rng
if not cl.value = "" then
' rest of procedure
end if
next cl

Different method

Option Explicit

Sub test()
    Dim r As Range, temp, num
    Const div As Double = 22.046
    With CreateObject("VBScript.RegExp")
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            If r.Value Like "*USD/MT" Then
                r.Value = Replace(r.Value, "USD/MT", "USC/LB")
                .Pattern = "(\+|\-)(\d+(\.\d+))"
                If .test(r.Value) Then
                    num = Format$(Round(CDbl(.Execute(r.Value)(0).submatches(1)) / div, 2), "#.0000")
                    r.Value = .Replace(r.Value, .Execute(r.Value)(0).submatches(0) & num)
                    r.Characters(1, 2).Font.Bold = True
                    r.Characters(.Execute(r.Value)(0).firstindex + 2, _
                    .Execute(r.Value)(0).Length - 1).Font.Color = vbRed
                End If
                .Pattern = "USC/LB"
                r.Characters(.Execute(r.Value)(0).firstindex + 1, .Execute(r.Value)(0).Length).Font.Bold = True
            End If
        Next
    End With
End Sub

Very Cool! I can see I'm out of my league here! LOL But, I have a renewed interest in coding again.

This works great if the data is in column "A" what if the data appears in multiple columns (not always the same each time)? How would you modify this to execute on any column in the active worksheet?

I apologize for being such a noob

Thanks again

Very cool, jindon! I hadn't actually tried formatting specific characters before. My method was the first to come to mind (and perhaps easier for someone unfamiliar with regular expressions), but yours is cleaner (and more clever). Well done!

gyclone

Onece you get familiar with Regular Expressions, it will be very easy like math in elementary school level.

Looking at every column in worksheet would be resource-intensive and error prone. Better to find the right columns and only look at appropriate ranges. If you know what the column header will be, it's easy to search for that text and base range off of the result. Let us know if that will work for you.

Totally!

The column headers will always be name as follows:

1. purch_valn_string
2. sales_valn_string

Change

For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))

to

For Each r In Activesheet.UsedRange

Thank You! That made the difference.

Thank you to all who contributed to the solution! I learned alot and can't thank you all enough!!

You all ROCK!!!!!!!!