Conversion from Lakh separator to Million

[Dhavalshah]

Hi,

I have made presentation from Lakh separator ( E.g. 1,23,45,222) and now I require to convert in million separator ( E.g. 12,345,222).

Need help for the same.

[HansV]

Could you attach a small sample presentation without sensitive data?

[StuartR]

To convert the string you could use a simple function like

Code: Select all

Public Function LakhToMillions(inS As String) As String

    LakhToMillions = Format(Replace(inS, ",", ""), "#,##0")
    
End Function

This will ignore any decimal point or numbers after the point.

Where do you have the numbers that you want to convert?

[Dhavalshah]

It is in power point slide and presentation contains more than 70 slides.

I am not able to use above function in Power Point.

[StuartR]

Try running this Macro on a copy of your presentation. Do check that the result is what you want before you replace the original.

Code: Select all

Sub UpdateAllTextToMillions()

Dim sld As Slide, shp As Shape, wrd As Variant
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.TextFrame.HasText Then
                For Each wrd In shp.TextFrame.TextRange.Words
                    If IsNumeric(wrd) Then wrd.Text = Format(Replace(wrd, ",", ""), "#,##0")
                Next wrd
            End If ' shp.TextFrame.HasText
        Next shp
    Next sld
    
End Sub

[Dhavalshah]

It is not working attaching error message for reference.

[StuartR]

Ah, that is because you have some shapes that are grouped. Try this version

Code: Select all

Sub UpdateAllTextToMillions()

Dim sld As Slide, shp As Shape, shp2 As Shape, wrd As Variant
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoGroup Then
                For Each shp2 In shp.GroupItems
                    If shp2.TextFrame.HasText Then
                        For Each wrd In shp2.TextFrame.TextRange.Words
                            If IsNumeric(wrd) Then wrd.Text = Format(Replace(wrd, ",", ""), "#,##0")
                        Next wrd
                    End If ' shp.TextFrame.HasText
                Next shp2
            Else ' shp.Type = msoGroup
                If shp.TextFrame.HasText Then
                    For Each wrd In shp.TextFrame.TextRange.Words
                        If IsNumeric(wrd) Then wrd.Text = Format(Replace(wrd, ",", ""), "#,##0")
                    Next wrd
                End If ' shp.TextFrame.HasText
            End If ' shp.Type = msoGroup
        Next shp
    Next sld
    
End Sub

[Dhavalshah]

It is still not working. attaching one of table from PPT for your reference and I want to change number from lakh to million in tables only.

[StuartR]

My goodness, hiding the text in table cells made this a bit more complex...

This version will ignore everything that isn't in a table, if you want to change all numbers even if they aren't in tables then it will be easy to add this.

Code: Select all

Sub UpdateAllTextToMillions()

Dim sld As Slide, shp As Shape, shp2 As Shape, wrd As Variant
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoGroup Then
                For Each shp2 In shp.GroupItems
                    UpdateOneShape (shp2)
                Next shp2
            Else ' shp.Type = msoGroup
                UpdateOneShape shp
            End If ' shp.Type = msoGroup
        Next shp
    Next sld
    
End Sub

Private Function UpdateOneShape(inshp As Shape)

    If inshp.Type = msoTable Then
        Dim rw As Row
        Dim cl As Cell
        
        For Each rw In inshp.Table.Rows
            For Each cl In rw.Cells
                If cl.Shape.TextFrame.HasText Then
                    For Each wrd In cl.Shape.TextFrame.TextRange.Words
                        If IsNumeric(wrd) Then wrd.Text = Format(Replace(wrd, ",", ""), "#,##0")
                    Next wrd
                End If
            Next cl
        Next rw
    End If 'inshp.type = msoTable
    
End Function

[Dhavalshah]

It is showing error attaching for reference.

[StuartR]

That is strange. This Macro ran with no errors on the PowerPoint file that you uploaded earlier.
I can't really offer much more help unless you upload the actual file that is giving you the error. Feel free to anonymise any text first.

[Dhavalshah]

It is working after Removing "For Each shp2 In shp.GroupItems" from macro. Is it possible it not alter number expressed in % for e.g. 24.1% gets converted in to 24%. I want it to be 24.1% only.

or

Is it possible to run macro for selected cell or area.

[HansV]

StuartR's code works in the sample presentation that you provided. I have attached the presentation with the code.

S1729.png

Presentation1.pptm

[HansV]

It is always better to provide a relevant example at the outset, instead of adding complications one by one...

[Dhavalshah]

Actually, I got slide having percentage after the post so not aware of the same at time of posting. Thanks for the Help.

[HansV]

Change the function as follows (the macro remains the same):

Code: Select all

Private Function UpdateOneShape(inshp As Shape)

    Dim rw As Row
    Dim cl As Cell
    Dim txt As TextRange
    Dim wrd As String

    If inshp.Type = msoTable Then
        For Each rw In inshp.Table.Rows
            For Each cl In rw.Cells
                If cl.Shape.TextFrame.HasText Then
                    Set txt = cl.Shape.TextFrame.TextRange
                    wrd = txt.Text
                    If IsNumeric(wrd) Then
                        If Not wrd Like "*%" Then
                            txt.Text = Format(Replace(wrd, ",", ""), "#,##0")
                        End If 'wrd like "*%"
                    End If 'IsNumeric(wrd)
                End If 'cl.Shape.TextFrame.HasText
            Next cl
        Next rw
    End If 'inshp.type = msoTable

End Function

[Dhavalshah]

Thanks it is working well. will take care from next time for letter complications.

[StuartR]

Thank you Hans

[Dhavalshah]

It converts negative figure from brackets to - sign e.g. (123,444) to -123,444. it was not the case with earlier macro and function. Is it possible in updated function.

[HansV]

There were no negative numbers in your sample presentation...

Code: Select all

Private Function UpdateOneShape(inshp As Shape)

    Dim rw As Row
    Dim cl As Cell
    Dim txt As TextRange
    Dim wrd As String

    If inshp.Type = msoTable Then
        For Each rw In inshp.Table.Rows
            For Each cl In rw.Cells
                If cl.Shape.TextFrame.HasText Then
                    Set txt = cl.Shape.TextFrame.TextRange
                    wrd = txt.Text
                    If IsNumeric(wrd) Then
                        If Not wrd Like "*%" Then
                            txt.Text = Format(Replace(wrd, ",", ""), "#,##0;(#,##0)")
                        End If 'wrd like "*%"
                    End If 'IsNumeric(wrd)
                End If 'cl.Shape.TextFrame.HasText
            Next cl
        Next rw
    End If 'inshp.type = msoTable

End Function