Convert cells with percentage format to 'same' decimal in a column with mixed format

[magna]

I have a column of cells with values - 0.2%, 0.32%, 0.22, 0.5 etc.
The cells with % symbol are in ' Percentage, 2 decimal' format while the plain numbers are in 'General' format i.e. column contains cells in either of these formats.
I need a macro where I can specify the column and it will select the cells with the % format, convert it to 'General' and multiply the result by 100 eg. 0.2% converted to 'General' becomes 0.002. When multiplied by 100, result is 0.2 i.e. is displayed without the % symbol.

Many thanks for your help.

[acw]

Hi

How about

Sub ddd() 
    For Each ce In  Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column).End(xlUp)) 
        If ce.NumberFormat = "0.00%" Then 
            ce.NumberFormat = general 
            ce.Value = ce.Value * 100 
        End If 
    Next ce 
End Sub 

This runs based on the currently selected cell. No testing is done for multiple cell selections etc.

HTH

Tony

[magna]

Thanks acw!
I ran your code and it works till the last selected cell (I did a small test by selcting only 2 cells). Once that cell is formatted etc. it fails on the 'Next...' command with error 92 - For loop not initialized.
I am including my code below (with comments and queries). Appreciate if obvious errors can be corrected with helpful comments.

Dim rCell As Range 
Dim rRange As Range 
Dim iChoice As Integer 
 
If Selection.Cells.Count = 1 Then 
     MsgBox "Please select the range to  convert", vbInformation 
    Exit Sub 
End If 
 
On Error Resume Next 
 ' I am working on Auto- filtered data. Hence I need my range to consist of
 'visible cells in my selection.
Set rRange = Selection.SpecialCells(xlCellTypeVisible) 
 
For Each rCell In rRange '(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column).End(xlUp))  ... Have modified your  formula here to suit
    If rCell.NumberFormat = "0.00%" Then 
        rCell.NumberFormat = "general" 
        rCell.Value = rCell.Value * 100 
    End If 
Next rCell 
 
 ' I now need to color rRange cells RED
With Selection.Interior 
    .ColorIndex = 3 
    .Pattern = xlSolid 
End With 
 
 'QUERY: I need to colour RED corresponding cells 4 columns to right. Is following code OK?
Set rRange = rRange.Offset(, 4).SpecialCells(xlCellTypeVisible).Select 
With Selection.Interior 
    .ColorIndex = 3 
    .Pattern = xlSolid 
End With 
 
iChoice = MsgBox("Wish to copy Fee Type & P Chg Criteria?", vbYesNo) 
If iChoice = vbYes Then 
    MsgBox "Please select cells to copy" 
     ' QUERY: I now need to manually select 2 adjacent cells from different columns after the msgbox and then copy them. I think something is missing
     ' between OK on msgbox to the next code line i.e how will the macro allow me to select and then remember the selection? Please help.
    Selection.Copy 
    On Error Resume Next   'QUERY:Is this error capture  step OK. Quite confused on which steps to include error lines?
     
    MsgBox "Please select destination range"   'QUERY: same problem as above.
    Set rRange = Selection.SpecialCells(xlCellTypeVisible) 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
Else 
    Exit Sub 'This for vbNo choice.
End If 
On Error Goto 0   'QUERY:Confused if this line is OK here?
End Sub 

Thanks again for your assistance.

Originally Posted by acw

Hi

How about

Sub ddd() 
    For Each ce In Range(Cells(1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column).End(xlUp)) 
        If ce.NumberFormat = "0.00%" Then 
            ce.NumberFormat = general 
            ce.Value = ce.Value * 100 
        End If 
    Next ce 
End Sub 

This runs based on the currently selected cell. No testing is done for multiple cell selections etc.

HTH

Tony

[acw]

Hi

Interesting - original code worked for me.

Can you give a small sample file showing what it is you are doing, and the expected results for given circumstances.


Tony

[magna]

Hi,
Sample file attached. Even though the sample file does not have it, presume I have filtered the data and the cells shown are just the 'visible' cells ie. row numbers are not continuous.

Col D has the mixed format. There can be blank cells in which case nothing needs to be done. Once formats fixed, the selected range in column D plus the corresponding cells in col E are to given a 'red' background colour. Please also see my code with the sequence of what I'm trying to achieve.

Many thanks ...

[acw]

HI

Try the attached. Put your cursor on sheet1!D3, then run the macro ddd. Converts OK for me.



Tony

[magna]

Thanks acw - that worked.

Can you explain what your first line of code does? Specifically " Range(...,Cells(Rows.Count, ActiveCell.Column).End(xlUp))"

I think Cells(Rows.Count, ActiveCell.Column) determines the the row number by counting all the rows with data entry and ActiveCell.Column identifies the column number but why do we need End(xlUp)?

Thanks for the explanation...

[acw]

Hi

Cells(rows.count,activecell.column) actually selects the last row in the spreadsheet (currently 65536) for the column you have selected. The xlup then does the equivalent of the ctrl up arrow which takes you to the last row with data in the currently selected column. If you come up from the bottom, you don't have the problem of blank cells if you try to go from the top down.

The code selects from row 1 in the current column, to the last row with data in the current column.


Tony