Convert numbers into text in a range and main current cell format per cell

Qadah

New Member
Joined
Sep 5, 2013
Messages
24
Hi,

In a macro that i've just finished, i copy a range of cells and to another workbook/sheet as values and maintain number formats

I need to convert the numbers in the range to text values (to upload into a system that can't properly format long numbers), and maintain the number formats they are

this is the code i am using the copy and paste the range (its a dynamic range, works fine)

VBA Code:
shRead.Cells(iRows + iStartRow + 1, 3), shRead.Cells(iRows + iStartRow + 1 + Comps_num, 18)).Copy
                
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).PasteSpecial Paste:=xlPasteFormats
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).PasteSpecial Paste:=xlPasteValues



The range i have cells formatted like numbers in the format of ##.## and percentages (consider all as ##.##%) as well, I also have some text fields

is there a way to do so? basically maintain format for numbers while making them as text? I tried using range.NumberFormat = "@", but that basically convert all numbers to their number formats

Thanks
 

Attachments

  • Capture.PNG
    Capture.PNG
    16.3 KB · Views: 6

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Is the other system reading directly from the spreadsheet ? It is fairly unusual for a system to ignore the number formatting applied. Also if you export as csv for the upload it saves per the number format displayed.

If you do need to convert it to text, see if the below works for you.
Instead of using copy paste, use the assignment (=) and format the cell as text before you do that.
Assuming the whole column is going to be the same it might be faster to format the whole column as text at the beginning instead of 1 cell at at time.
I have used the Sheet code name, you would use your shWrite2.Range syntax.

VBA Code:
Sub test()

    Sheet2.Range("C3").NumberFormat = "@"
    Sheet2.Range("C3") = Trim(Sheet1.Range("C3").text)

End Sub

1617190002303.png
 
Upvote 0
HI,

the reason the system cant not handle formats is that it was custom built, and it just doesn't support formatting, and sadly the csv is not an option since the on platform we upload a workbook with two predefined sheet names

i tried your method, and i know before i tried it i know i would face an issue i faced while building the macro, i initially didnt use copy paste, but rather range = range, but for some reason that didnt work, as i get an empty range.

I didn't want to post my entire code before not to bother you guys, I will paste it now and highlight the section in question:

old part is 'ed, and new is active

a quick explanation for the macro:

the macro is stored in workbook, that extracts data from another workbook (opened by the macro), converts one sheet from the source sheet into 2 sheets (Values & Headers) in the destination

issues i am facing:
1. the text formatting issue
2. its slow, takes 5 minutes for the full thing to work, for testing i am restricting the rows to 140

VBA Code:
Option Explicit
Sub Indices_maker()
    Dim wb As Workbook, wb2 As Workbook
    Dim ws As Worksheet
    Dim vFile As Variant
   
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
   
    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
        1, "Select One File To Open", , False)
   
    'if the user didn't select a file, exit sub
   
        If TypeName(vFile) = "Boolean" Then Exit Sub
   
    'Set source workbook
   
    Set wb = Workbooks.Open(vFile, True, True)        ' Open the source file.
   
    Application.ScreenUpdating = False
   
    'Set reads and writes
    Dim shRead As Worksheet, shWrite, shWrite2 As Worksheet
   
    Set shRead = wb.Worksheets("Indices")
    Set shWrite = ThisWorkbook.Worksheets("Headers")
    Set shWrite2 = ThisWorkbook.Worksheets("Values")

    'Calcualte once manually
   
    Application.Calculate
 
    'Copy get number of indices
   
    Dim iRowsCount As Integer          ' Get the total Used Range rows in the source file.
    iRowsCount = wb.Worksheets("Indices").UsedRange.Rows.Count
   
    'for now i dont need column number:
    'Dim iColumnsCount As Integer     ' Get the total Columns in the source file.
    'iColumnsCount = src.Worksheets("sheet1").UsedRange.Columns.Count
   
    Dim iRows, iCols, iStartRow, StartPasteRow, KPIID As Integer
    Dim Department, D_ID, KPIName, Category, CategoryID, YearNum As String
    Dim DIDTable, KPIInfo, Comp As Range
   
    Set DIDTable = ThisWorkbook.Worksheets("Tables").ListObjects("DeptIDtable").Range
    Set KPIInfo = ThisWorkbook.Worksheets("Tables").ListObjects("KPIsinfo").Range
   
    ThisWorkbook.Worksheets("Tables").Range("comps").NumberFormat = "@"
    Set Comp = ThisWorkbook.Worksheets("Tables").Range("comps")
   
    YearNum = ThisWorkbook.Worksheets("Tables").Range("A2").Value
   
    iStartRow = 2
    StartPasteRow = 0
   
    '_________________Create Headers________________
   
    'clear destination Headers sheet
   
    shWrite.Rows("2:" & Rows.Count).ClearContents
   
[COLOR=rgb(147, 101, 184)]    ' Now, read the index sheet from mastersheet and copy data to the Headers sheet, change 140 to iRowsCount when done testing
    For iRows = 0 To 140[/COLOR]
           If WorksheetFunction.IsText(shRead.Cells(iRows + iStartRow, 1)) = True Then
               
                Department = shRead.Cells(iRows + iStartRow, 1).Value
                D_ID = Application.VLookup(Department, DIDTable, 2, False)
                KPIID = shRead.Cells(iRows + iStartRow, 2).Value
                Category = Application.VLookup(KPIID, KPIInfo, 4, False)
                CategoryID = Application.VLookup(KPIID, KPIInfo, 5, False)
                KPIName = Application.VLookup(KPIID, KPIInfo, 6, False)
               
                ' copy department name
                shRead.Cells(iRows + iStartRow, 1).Copy
               
                'fill KPI values
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 1), shWrite.Cells(StartPasteRow + iStartRow + 15, 1)).PasteSpecial Paste:=xlPasteValues
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 2), shWrite.Cells(StartPasteRow + iStartRow + 15, 2)) = D_ID
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 3), shWrite.Cells(StartPasteRow + iStartRow + 15, 3)) = Category
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 4), shWrite.Cells(StartPasteRow + iStartRow + 15, 4)) = CategoryID
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 5), shWrite.Cells(StartPasteRow + iStartRow + 15, 5)) = KPIName
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 6), shWrite.Cells(StartPasteRow + iStartRow + 15, 6)) = KPIID
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 7), shWrite.Cells(StartPasteRow + iStartRow + 15, 7)) = YearNum
               
                'fill component values
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 8), shWrite.Cells(StartPasteRow + iStartRow + 15, 8)).Formula = Comp.Value
                shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 8), shWrite.Cells(StartPasteRow + iStartRow + 15, 8)).NumberFormat = "@"
               
                StartPasteRow = StartPasteRow + 16
               
                End If
    Next iRows
   
    'iStartRow = iRows + 1
    iRows = 0
   
   '_________________Create Values________________
   

    'clear destination Headers sheet
   
    shWrite2.Rows("2:" & Rows.Count).ClearContents
   
    ' Now, read the index sheet from mastersheet and copy data to the Values sheet
   
    Dim Comps_num As Integer
    Dim CompV, CompVW, chkblank As Range
       
    iStartRow = 2
    StartPasteRow = 0
       
   
[COLOR=rgb(147, 101, 184)]    ' Now, read the index sheet from mastersheet and copy data to the values sheet, change 140 to iRowsCount when done testing
   
    For iRows = 0 To 140[/COLOR]
           If WorksheetFunction.IsText(shRead.Cells(iRows + iStartRow, 1)) = True Then
   
                Department = shRead.Cells(iRows + iStartRow, 1).Value
                Comps_num = shRead.Cells(iRows + iStartRow + 1, 1).Value
                D_ID = Application.VLookup(Department, DIDTable, 2, False)
                KPIID = shRead.Cells(iRows + iStartRow, 2).Value
                Category = Application.VLookup(KPIID, KPIInfo, 4, False)
                CategoryID = Application.VLookup(KPIID, KPIInfo, 5, False)
                KPIName = Application.VLookup(KPIID, KPIInfo, 6, False)

               
                ' copy department name
                shRead.Cells(iRows + iStartRow, 1).Copy
               
                'fill KPI values
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 1), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 1)).PasteSpecial Paste:=xlPasteValues
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 2), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 2)) = D_ID
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 3), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 3)) = Category
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 4), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 4)) = CategoryID
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 5), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 5)) = KPIName
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 6), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 6)) = KPIID
               
                '[COLOR=rgb(84, 172, 210)]original copy paste
               
                'shRead.Range(shRead.Cells(iRows + iStartRow + 1, 3), shRead.Cells(iRows + iStartRow + 1 + Comps_num, 18)).Copy
               
                'shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).PasteSpecial Paste:=xlPasteFormats
                'shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).PasteSpecial Paste:=xlPasteValues[/COLOR]
               
               [COLOR=rgb(97, 189, 109)] ' with trim
               
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).NumberFormat = "@"
                shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).NumberFormat = Trim(shRead.Range(shRead.Cells(iRows + iStartRow + 1, 3), shRead.Cells(iRows + iStartRow + 1 + Comps_num, 18)).Text)
                          
                Trim(shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22)).NumberFormat).Text[/COLOR]
               
               
                'replace blanks with -
                Set CompVW = shWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22))
                CompVW.Replace "", "-", xlWhole

                StartPasteRow = StartPasteRow + Comps_num + 1
       
            End If
    Next iRows
   
   iRows = 0
   
   
    ' Close the source file.
    wb.Close False         ' False, so you don't save the source file.
    Set wb = Nothing
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Without going through all your code what about changing these your 2 lines as per the below ?
The order matters ( I have swapped them around) and changed the = Comp.value line.
I don't understand this line though and if its not a single cell the code may not work.
Set Comp = ThisWorkbook.Worksheets("Tables").Range("comps")

VBA Code:
    shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 8), shWrite.Cells(StartPasteRow + iStartRow + 15, 8)).NumberFormat = "@"
    shWrite.Range(shWrite.Cells(StartPasteRow + iStartRow, 8), shWrite.Cells(StartPasteRow + iStartRow + 15, 8)) = Trim(Comp.text)
 
Upvote 0
Comp is a range variable that refers to a range of defined cells, in as you can see the local workbook, but this is not the same range that I need to copy.

The range i need to copy is defined this one:

VBA Code:
shRead.Cells(iRows + iStartRow + 1, 3), shRead.Cells(iRows + iStartRow + 1 + Comps_num, 18))

destination is

VBA Code:
hWrite2.Range(shWrite2.Cells(StartPasteRow + iStartRow, 7), shWrite2.Cells(StartPasteRow + iStartRow + Comps_num, 22))

when i assign the source range to variable and then try to apply i( destination = source) the range is always empty, thats why i am copying, i am not sure what's the issue, is it because the source is in a different workbook? i cant defined a simple range since this range is dynamic and is part of a loop
 
Upvote 0
I can't see how to avoid looping through the value cells.
I think using the Trim & .Text will be simpler than using the format statement since you have multiple formats.

Unfortunately the .Text property only seems to work on single cell assignments.

What I imagine it to look like is the below with both the Read column 3 and the Write column 7 being replaced with a variable counter.
eg for colRead = 3 to 18
and the colWrite being colRead +4

VBA Code:
shWrite2.Cells(StartPasteRow + iStartRow, 7) = trim(shRead.Cells(iRows + iStartRow + 1, 3).Text)
 
Upvote 0
I think this is the way forward,

but what i try to achieve is this (code aside)

All of these (except for the Hi) are exactly the same number: 1.0011123123 but each formatted separately, i need to convert the range into text, and preserve all, including the %, etc. is this possible with VBA ? i know how to do this using a formula (that needs helper cells (second row) and a lookup range (value types) that gets cell("format",ref) then replace the output (lookup) from a table with the text formula corresponding format:

For example, in the range i might have

value types
Original number with format100.11%1.00111231.00Hi$1.00P20#.00%
Cell Reference resultP2G,2GC2G
=IF(C10="G",C9,TEXT(C9,VLOOKUP(C10,$I$9:$J$13,2,FALSE)))100.11%1.00111231.00Hi$1.00,2#.00
G
C2$#,##0.00

The first row contains the original cells , the only solution i can think of (vba aside) is to get cell format, and have a lookup table ready with all possible cell format, then apply text function to convert the results in the my destination to text using helper cells and the lookup table

Thanks again
 
Upvote 0
I am unclear on what you are saying. Are you abandoning using VBA ?
The code I gave you will preserve the formatting and change the data to text.

Here is a sample of the what the code does, it shows the formatted Read line (row 5), the code generated Write line (row 10) which has retained the formatting and is now text.

1617275100484.png


The codes is per what I suggested earlier:-

VBA Code:
Sub TestCopy()

    Dim colRead As Long
    Dim wb As Workbook
    Dim sh As Worksheet
   
    Set wb = ThisWorkbook
    Set sh = wb.Worksheets("Read Temp")
   
    sh.Range(sh.Cells(10, 2), sh.Cells(10, 6)).NumberFormat = "@"
    For colRead = 2 To 6     
        sh.Cells(10, colRead) = Trim(sh.Cells(5, colRead).text)   
    Next colRead

End Sub
 
Upvote 0
Solution
Hi Alex,

thanks a lot for the help, it took me a while to figure the double loops, but managed to do it eventually:

VBA Code:
For RawRead = 0 To Comps_num
                    For ColRead = 3 To 18
                
                        shWrite2.Cells(StartPasteRow + iStartRow + RawRead, ColRead + 4) = Trim(shRead.Cells(iRows + iStartRow + 1 + RawRead, ColRead).Text)
                    
                    Next ColRead
           Next RawRead

Thank again
 
Upvote 0
Glad you managed to get it working, and its doing the job. Thanks for letting me know.
 
Upvote 0

Forum statistics

Threads
1,213,517
Messages
6,114,089
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top