VBA Remove format from empty cells in Excel - vba

I need a quick code to clean the format of all the cells that are empty.
I have written this code, but it is too slow. Is there a way to make it quicker?
Sub removeFormatEmpty()
'Declaration of variables
Dim sheet As Worksheet
Dim rcell As Range
For Each sheet In Worksheets
sheet.Activate
'Cells.UnMerge
For Each rcell In sheet.UsedRange.Cells
If rcell.MergeCells = True Then
rcell.UnMerge
End If
If rcell.Value = "" Then
rcell.ClearFormats
End If
Next rcell
Next sheet
End Sub
This code works, however it is slow as it needs to go cell by cell. Is there a way to select the whole range except the cells with content?
Update:
Thank you to the comments of bobajob and jordan I've been able to update the code and make it much more faster and optimized. It is the new code:
Sub removeFormatEmptyImproved()
Dim sheet As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each sheet In Worksheets
'sheet.Activate
sheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
Next sheet
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
So now it is solved.

Firstly, you don't have to check whether a cell is merged before unmerging it. So to unmerge all cells in sheet...
sheet.UsedRange.UnMerge
You don't need to activate a sheet before altering it
As mentioned in the comments, you can alter all cells at once by using
sheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
Turning Calculation to manual and ScreenUpdating to false is an easy go-to method to speed most VBA code up!
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' <other code>
' Include error handling so that these are always set back!
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
So your resulting Sub would be
Sub removeFormatEmpty()
Dim sheet As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each sheet In ThisWorkbook.Worksheets
sheet.UsedRange.UnMerge
sheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
Next sheet
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
A final step to speed things up would be to dig into your UsedRange a little more. It can be notorious for remembering long-unused cells and being far bigger than necessary. If you know your sheet layout, there may be a way to restrict the range you are working with.
See some methods for doing this here:
Getting the actual usedrange

Related

VBA - Range("All cells but a few")

I am trying to clear the contents of all cells on a worksheet apart from a specific range. I have tried to copy the range to the clipboard then to paste it back on again in the same place, however excel being the usual tricky beast - it doesn't want to play ball.
The range I would like to keep the same is AB1:AC5.
Any Suggestions Apprichiated...
(here is my code)
Sub Button21_Click()
Application.ScreenUpdating = False
With Worksheets(2)
.Range("AB1:AC5").Copy
.Cells.ClearContents
.Paste(Destination:=Sheets("Data").Range("AB1"))
End With
Application.ScreenUpdating = True
End Sub
use an array instead:
Sub Button21_Click()
Application.ScreenUpdating = False
Dim oldValues As Variant
With Worksheets(2)
oldValues = .Range("AB1:AC5").Value
.Cells.ClearContents
.Range("AB1:AC5").Value = oldValues
End With
Application.ScreenUpdating = True
End Sub

Copy cells formulas VBA

I did a program in VBA to copy the formulas in each cell in a specific column, I have 30501 points and the program is really slow even to calculate 100 points, there is a better way to do so?
Sub Copyformulas()
Dim i As Integer
Dim cell As Range
Dim referenceRange As Range
Dim a As String
a = "$T$30510"
Set range1= ActiveSheet.Range("A1:A30510")
Set myrange = Range("T16:T30510")
i = 16
Do Until Cells(20, 30510)
With range1
For Each cell In myrange
If cell.HasFormula Then
Cells(i, 35).Value = cell.Address
Cells(i, 36).Value = "'" & CStr(cell.Formula)
i = i + 1
End If
Next
End With
Loop
End Sub
You can use SpecialCells to refine your range. You don't need to use ActiveSheet it is implied.
Set rSource = Range("A16:A30510").SpecialCells(xlCellTypeFormulas)
Sub Copyformulas()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim c As Range
Dim rSource As Range
Set rSource = ActiveSheet.Range("A16:A30510").SpecialCells(xlCellTypeFormulas)
For Each c In rSource
c.Offset(0, 34) = c.Address
c.Offset(0, 35) = "'" & c.Formula
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Try adding the following:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
... Your Code ...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
You may only need the first one, but they are all good practice in using. Also, where are you using the With ... End With statement? I don't see any use of it in the block.
It is good practice to use Option Explicit at the top of the module. And range1 and myrange are not declared.
Application.Calculation
When a worksheet is accessed or a range's precedents has changed, Excel will automatically recalculate the formulas on the worksheet. Since you are looping over 30,000 times, this causes Excel to recalculate each time through the loop and, thus, slows down performance.
Application.ScreenUpdating
This line stops Excel from screen flashes and other things that occur as the macro runs.
Application.EnableEvents
This line turns off events, such as Worksheet_Change, so that the event is not triggered. If it is not turned off then any time a change occurs on the worksheet the code in the change event will run. If you have a Worksheet_SelectionChange event then code will run every time you select a different cell. These events are written in the worksheet or workbook objects located in the project window of the VBE and there are many events to choose from. Here is a very simple illustration. Place the following in the Sheet1 object in the project window:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "Hi!"
End Sub
Now click around on the worksheet. You see it responds to each selection change. Now place the following in a regular module:
Sub TestEnableEvents()
Application.EnableEvents = False
ActiveCell.Offset(1, 0).Select
Application.EnableEvents = True
End Sub
When you run the above code the message box will not be triggered.

Run a Macro every time sheet is changed

i'm still fairly new to macros, i've got a bit of code i need to run on a sheet every time it gets updated, changed, or whatever.
Here is the code I need to run: How can i do this?
Sub UnMergeFill()
Dim cell As Range, joinedCells As Range
For Each cell In ThisWorkbook.ActiveSheet.UsedRange
If cell.MergeCells Then
Set joinedCells = cell.MergeArea
cell.MergeCells = False
joinedCells.Value = cell.Value
End If
Next
End Sub
You can boost the efficiency of your macro by locating the merged cells to process rather than looping through every cell in the Worksheet.UsedRange property and examining it for the Range.MergeCells Property.
Within the worksheet's conventional Range.Find method, there is an option to look for formatting. On this sub-dialog's Alignment tab, you'll find the option to locate Merged cells.
        
This can be incorporated into your VBA sub procedure using the Range.Find method and the Application object's .FindFormat property.
Your sub procedure using FindFormat:
Sub UnMergeFill(Optional ws As Worksheet)
If ws Is Nothing Then Set ws = ActiveSheet
Dim fndMrg As Range, joinedCells As Range
Application.FindFormat.MergeCells = True
With ws
On Error Resume Next
Set fndMrg = .Cells.Find(What:=vbNullString, SearchFormat:=True)
Do While Not fndMrg Is Nothing
Set joinedCells = fndMrg.MergeArea
fndMrg.MergeCells = False
'fndMrg.UnMerge '???
joinedCells.Value = fndMrg.Value
Set fndMrg = .Cells.Find(What:=vbNullString, SearchFormat:=True)
Loop
End With
Application.FindFormat.MergeCells = False
End Sub
Slightly revised Worksheet_Change event macro with more environment shutdown during processing.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Call UnMergeFill(Target.Parent)
bm_Safe_Exit:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I've opted to specify the worksheet to be processed rather than rely on the ActiveSheet property. There is the possibility that the Worksheet_Change could be initiated by an outside process when it is NOT the active sheet.
In short, opt for bulk operations whenever possible and avoid looping whenever you can. This is not blinding fast but it should be substantially quicker than looping through the cells.
In the code module for that particular worksheet, just add this:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
UnMergeFill
Application.EnableEvents = True
End Sub

Quickest way to clear all sheet contents VBA

I have a large sheet that I need to delete all the contents of. When I try to simply clear it without VBA it goes into not responding mode. When using a macro such as:
Sub ClearContents ()
Application.Calculation = XlManual
Application.ScreenUpdating = False
Sheets("Zeroes").Cells.ClearContents
Application.ScreenUpdating = True
End Sub
It also doesn't respond. What's the quickest way to do this?
The .Cells range isn't limited to ones that are being used, so your code is clearing the content of 1,048,576 rows and 16,384 columns - 17,179,869,184 total cells. That's going to take a while. Just clear the UsedRange instead:
Sheets("Zeros").UsedRange.ClearContents
Alternately, you can delete the sheet and re-add it:
Application.DisplayAlerts = False
Sheets("Zeros").Delete
Application.DisplayAlerts = True
Dim sheet As Worksheet
Set sheet = Sheets.Add
sheet.Name = "Zeros"
EDIT: (#tavnab and #Azura)
Heads up for future readers, you cannot delete a sheet if it's the last/only one in the workbook.
In that case, you can add the new blank sheet first, delete the old one, and finally rename that new sheet to the old sheet's name.
Also note that eliminating a sheet will create conflicts with formulas in other sheets that were referencing the recently eliminated one, recreating the sheet may not solve that issue.
Technically, and from Comintern's accepted workaround,
I believe you actually want to Delete all the Cells in the Sheet. Which removes Formatting (See footnote for exceptions), etc. as well as the Cells Contents.
I.e. Sheets("Zeroes").Cells.Delete
Combined also with UsedRange, ScreenUpdating and Calculation skipping it should be nearly intantaneous:
Sub DeleteCells ()
Application.Calculation = XlManual
Application.ScreenUpdating = False
Sheets("Zeroes").UsedRange.Delete
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Or if you prefer to respect the Calculation State Excel is currently in:
Sub DeleteCells ()
Dim SaveCalcState
SaveCalcState = Application.Calculation
Application.Calculation = XlManual
Application.ScreenUpdating = False
Sheets("Zeroes").UsedRange.Delete
Application.ScreenUpdating = True
Application.Calculation = SaveCalcState
End Sub
Footnote: If formatting was applied for an Entire Column, then it is not deleted.
This includes Font Colour, Fill Colour and Borders, the Format Category (like General, Date, Text, Etc.) and perhaps other properties too, but
Conditional formatting IS deleted, as is Entire Row formatting.
(Entire Column formatting is quite useful if you are importing raw data repeatedly to a sheet as it will conform to the Formats originally applied if a simple Paste-Values-Only type import is done.)
You can use the .Clear method:
Sheets("Zeros").UsedRange.Clear
Using this you can remove the contents and the formatting of a cell or range without affecting the rest of the worksheet.
Try this one:
Sub clear_sht
Dim sht As Worksheet
Set sht = Worksheets(GENERATOR_SHT_NAME)
col_cnt = sht.UsedRange.Columns.count
If col_cnt = 0 Then
col_cnt = 1
End If
sht.Range(sht.Cells(1, 1), sht.Cells(sht.UsedRange.Rows.count, col_cnt)).Clear
End Sub

Why is a small Excel VBA Macro is running extremely slow

I am writing a short macro to hide all customers that have no current sales for the current year. The YTD sales are in the K column (specifically K10-250). Those cells use a vlookup to pull data from another tab where we dump data. My question is why on earth would this macro take 10-15minutes to run? I have a similar macro on another spreadsheet that takes only 2-3 minutes for over 1,500 rows. I have already turned off screen updating. I can't think of anything else that would speed it up.
Sub HideNoSlackers()
'
' HideNoSlackers Macro
'
'
Application.ScreenUpdating = False
'
Sheets("CONSOLIDATED DATA").Select
Dim cell As Range
For Each cell In Range("K10:K250")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
Next
End Sub
You might want the calculation to be set Manual before hiding the rows? Also you can get rid of If statements in your case. Try this:
Sub HideNoSlackers()
Dim cell As Range, lCalcState As Long
Application.ScreenUpdating = False
' Record the original Calculation state and set it to Manual
lCalcState = Application.Calculation
Application.Calculation = xlCalculationManual
For Each cell In ThisWorkbook.Worksheets("CONSOLIDATED DATA").Range("K10:K250")
cell.EntireRow.Hidden = (cell.Value = 0)
Next
' Restore the original Calculation state
Application.Calculation = lCalcState
Application.ScreenUpdating = True ' Don't forget set ScreenUpdating back to True!
End Sub
Sub HideNoSlackers()
Dim cell As Range, rng As Range, rngHide As Range
Set rng = Sheets("CONSOLIDATED DATA").Range("K10:K250")
rng.EntireRow.Hidden = False
For Each cell In rng.Cells
If cell.Value = 0 Then
If Not rngHide Is Nothing Then
Set rngHide = Application.Union(rngHide, cell)
Else
Set rngHide = cell
End If
End If
Next
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub
Why are you doing this with a macro?
If you create a table over the data, you can set up a filter on the sales column that will show only those where sales<> 0.
Macros are useful in excel but the majority of actions that people turn to macros for can be done natively in excel.
there must be something else that's wrong. Try without .Selecting the sheet but that's not a huge improvement
Note rows are visible by default so the Else statement should be optional really.
Sub HideNoSlackers()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Sheets("CONSOLIDATED DATA").Cells.EntireRow.Hidden = False
Dim cell As Range
For Each cell In Sheets("CONSOLIDATED DATA").Range("K10:K250")
If cell.Value = 0 Then cell.EntireRow.Hidden = True
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
the shortest code to achieve the same Goal in a very different way:
Sub column_K_not_NULL
Sheets("CONSOLIDATED DATA").Select
If ActiveSheet.FilterMode Then Selection.AutoFilter 'if an autofilter already exists this is removed
ActiveSheet.Range("$K$10:$K$250").AutoFilter Field:=1, Criteria1:="<>0"
End Sub
of course you could put in the standard minimums like
application.calculation = Manual
Application.ScreenUpdating = False
and other way round at the end.
Max
Try disabling page breaks. I had a similar problem that would happen after someone printed from the sheet. This turned on page breaks, and subsequent runs of the script would take forever.
ActiveSheet.DisplayPageBreaks = False
We found out, that the program Syncplicity in the Version 4.1.0.1533 slows down macros up to 15times slower because events trigger syncplicity.
with
Application.EnableEvents = False
;do your job here
Application.EnableEvents = True
the speed is back.