Skip to main content

How to zoom or magnify selected cells in Excel? 

As we all know, Excel has a Zoom feature to help us to increase the size of the cell value in the whole worksheet. But, sometimes, we just need to zoom or magnify only the selected cells. Are there any good ideas for us to enlarge the selected cells only in a worksheet?

Zoom or magnify the selected cell with VBA code


Zoom or magnify the selected cell with VBA code

May be there in no direct way for us to magnify the selected cells in Excel, but, here, I can introduce a VBA code to deal with this job as a workaround. Please do as follows:

1. Right click the sheet tab that you want to enlarge the selected cells automatically, and then choose View Code from the context menu, in the opened Microsoft Visual Basic for applications window, copy and paste the following code into the blank Module:

VBA code: Zoom or magnify the selected cells:

Private Sub worksheet_selectionchange(ByVal Target As Range)
'Updateby Extendoffice
    Dim xRg As Range
    Dim xCell As Range
    Dim xShape As Variant
    Set xRg = Target.Areas(1)
    For Each xShape In ActiveSheet.Pictures
        If xShape.Name = "zoom_cells" Then
            xShape.Delete
        End If
    Next
    If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
    Application.ScreenUpdating = False
    xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
    Application.ActiveSheet.Pictures.Paste.Select
    With Selection
        .Name = "zoom_cells"
        With .ShapeRange
            .ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
            With .Fill
                .ForeColor.SchemeColor = 44
                .Visible = msoTrue
                .Solid
                .Transparency = 0
            End With
        End With
    End With
    xRg.Select
    Application.ScreenUpdating = True
    Set xRg = Nothing
End Sub

2. Then save and close this code window, now, when you select or click some data cells, the cells will be magnified as a picture automatically, see screenshot:

Note: The selected cells will be changed back to original size after selecting other cells.

Best Office Productivity Tools

Popular Features: Find, Highlight or Identify Duplicates   |  Delete Blank Rows   |  Combine Columns or Cells without Losing Data   |   Round without Formula ...
Super Lookup: Multiple Criteria VLookup    Multiple Value VLookup  |   VLookup Across Multiple Sheets   |   Fuzzy Lookup ....
Advanced Drop-down List: Quickly Create Drop Down List   |  Dependent Drop Down List   |  Multi-select Drop Down List ....
Column Manager: Add a Specific Number of Columns  |  Move Columns  |  Toggle Visibility Status of Hidden Columns  |  Compare Ranges & Columns ...
Featured Features: Grid Focus   |  Design View   |   Big Formula Bar    Workbook & Sheet Manager   |  Resource Library (Auto Text)   |  Date Picker   |  Combine Worksheets   |  Encrypt/Decrypt Cells    Send Emails by List   |  Super Filter   |   Special Filter (filter bold/italic/strikethrough...) ...
Top 15 Toolsets12 Text Tools (Add Text, Remove Characters, ...)   |   50+ Chart Types (Gantt Chart, ...)   |   40+ Practical Formulas (Calculate age based on birthday, ...)   |   19 Insertion Tools (Insert QR Code, Insert Picture from Path, ...)   |   12 Conversion Tools (Numbers to Words, Currency Conversion, ...)   |   7 Merge & Split Tools (Advanced Combine Rows, Split Cells, ...)   |   ... and more

Supercharge Your Excel Skills with Kutools for Excel, and Experience Efficiency Like Never Before. Kutools for Excel Offers Over 300 Advanced Features to Boost Productivity and Save Time.  Click Here to Get The Feature You Need The Most...

kte tab 201905


Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
Comments (10)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Ragazzi perso cos' non posso correggere la singola cella...esiste un modo per ingrandire la singola cella una volta selezionata e lavorarci sopra ?
This comment was minimized by the moderator on the site
Hi,
This is great - thank you.

Would it be possible to only have this on a selection of cells on a sheet? For example, all cells in column A, or A3 to A26 for example?
Thank you!
Rhys
This comment was minimized by the moderator on the site
Hi,
I am using Mac-Air and it shows only the color when you click on ac particular cell, pls guide.
This comment was minimized by the moderator on the site
I have the same issue on my MBA M2 running Excel V16.62, blue background but no text seen
This comment was minimized by the moderator on the site
Error 1004 on line 15

Application.ActiveSheet.Pictures.Paste.Select

Why?, what could it be?
This comment was minimized by the moderator on the site
Hi, Mazzi,
The above code works well in my Excel workbook, which Excel version do you use?
This comment was minimized by the moderator on the site
I want to magnify when entering the data
This comment was minimized by the moderator on the site
Hi,
May be, there is no direct way for solving your problem, if you find a good method, please comment here.
This comment was minimized by the moderator on the site
this is cool, but i want it to run in all sheets, how can i do that?
This comment was minimized by the moderator on the site
Hi, Ahmet,
To apply this operation in all worksheets, you can use the below vba code. (You should put the code into the ThisWorkbook module).Please try it.
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)
For Each xShape In ActiveSheet.Pictures
If xShape.Name = "zoom_cells" Then
xShape.Delete
End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "zoom_cells"
With .ShapeRange
.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End Sub
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations