I have an SAP BW (Business Warehouse) report that is downloaded to Excel.
In this report the Volume is reported with various Units of Measure (e.g.
KG, EA, LB, etc) and the Revenue is reported in different currency (e.g.
EUR, CHF, JPY, or blank if it is USD).

These formats are achieve via the "Format Cells - Custom" command with the
format:

#,##0 "KG";-#,##0 "KG";

or

#,##0 "EUR";-#,##0 "EUR";

depending upon the unit of measure or currency of each record US Dollar
sales are formated with a simple

#,##0;-#,##0

I would like to move the text associated with the format (e.g. KG or EUR) to
the column next to the cell the amount is in. I can not figure out how to
identify the text part of the format of the cell such that cell A1 would
contain the number in its current format (e.g. 123 EUR) and cell B1 would
contain the text (e.g. EUR or KG). Can someone point me in the right VBA
direction?

Thanks,

Frank

With some help I was able to build the following function to accomplish
this.

Option Explicit


Function CustomFormatText(Cell) As String

' This function was written by Frank Hayes of DuPont with help
' from Rich Eagles of Deloitte Consulting and
' Niek Otten from the microsoft.public.excel.misc newsgroup
'
' The function will strip out the text between the first set
' of quote marks in the target cell and write them to
' the cell from which the function was called.
'
' It is meant to be used when you are trying to strip out the
' currency name from a cell that is format as a number with
' a custom format such as #,##0 "EUR"
'

Dim i As Long
Dim x As String
Dim CustomFormatString As String

Dim FirstQuote As Boolean
Dim SecondQuote As Boolean

FirstQuote = False
SecondQuote = False

CustomFormatString = Cell.NumberFormat

For i = 1 To Len(CustomFormatString)
x = Mid$(CustomFormatString, i, 1)

' Find the first quote sign in the custom format
If FirstQuote = False Then
If Asc(x) = 34 Then
FirstQuote = True
GoTo GetNextCharacter
End If
End If

' Find the second quote sign in the custom format
If FirstQuote = True Then
If Asc(x) = 34 Then
SecondQuote = True
GoTo TheEnd
End If
End If

' Write out the characters between the first and second quote
If FirstQuote = True And SecondQuote = False Then
CustomFormatText = CustomFormatText + x
End If

GetNextCharacter:
Next i

TheEnd:
End Function