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
Related
I have written code in VBA that removes some potential spaces between characters. The code works pretty well but becomes really slow when the file contains thousands of rows. I'd like to know if it's possible to improve it, in order to reduce the time of operation, but also mainly to stop the file from freezing. Here is the code:
Sub Test()
Dim cell as Range
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim areaToTrim As Range
Set sht = ThisWorkbook.Worksheets("SS upload")
Set StartCell = sht.Range("A14")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
Set areaToTrim = sht.Range("B14:B" & LastRow)
For Each cell In areaToTrim
cell.Value = Trim(cell.Value)
Next cell
End Sub
The fastest way is to read the range into an array, trim it there and then write it back to the range:
Sub Test()
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim areaToTrim As Range
Dim varArray() As Variant
Dim i As Long
Set sht = ThisWorkbook.Worksheets("SS upload")
Set StartCell = sht.Range("A14")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
Set areaToTrim = sht.Range("B14:B" & LastRow)
varArray = areaToTrim ' Read range into array
For i = LBound(varArray, 1) To UBound(varArray, 1)
varArray(i, 1) = Trim(varArray(i, 1))
Next i
areaToTrim.Value = varArray ' Write array back to range
End Sub
No need to worry about Application.ScreenUpdating or Application.Calculation. Nice and simple!
If you are still worried about any responsiveness, put a DoEventsin the body of the loop.
You can prevent the freezing when you insert DoEvents in your loop.
And then execute it, say every hundredth time.
This will make the loop run a little slower, but allows the user to use the GUI meanwhile.
...
Dim cnt As Integer
For Each cell In areaToTrim
cell.Value = Trim(cell.Value)
cnt=cnt + 1
If cnt Mod 100 = 0 Then
DoEvents
End If
Next cell
...
You can play around with the number to optimize it for your needs.
DoEvents brings also some problems with it. A good explanation about DoEvents can be found here.
Try like this, to reduce screenupdating. This is a piece of code, that I always use, thus some of the commands are probably a bit too much for the current question, but they can be still useful.
As a second point - do not declare a variable with the name Cell, you can suffer a bit from this later. Declare it rngCell or myCell or anything else, which is not part of the VBE variables.
Public Sub TestMe()
Call OnStart
'YourCode
Call OnEnd
End Sub
Public Sub OnEnd()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
End Sub
Public Sub OnStart()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
End Sub
If you feel like it, you may save the range as an array and do the trim operation there. However, it may overcomplicate your code, if you are not used to work with arrays - Trim Cells using VBA in Excel
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
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.
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
In my Excel file I have:
A
1 10-30
2 40-45
3 30-80
There can be any range of numbers separated by - in any cell.
In any particular column (might be any cell) i want to remove all text from the start to the - hyphen.
Example: 40-45 will be replaced with 45.
I've asked this question previously and i got the following solution
Sub Update()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Worksheet, ur As Range, r As Range
For Each ws In Sheet
Set ur = ws.UsedRange
For Each r In ur
On Error Resume Next
r = Split(r, "-")(1)
Next
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
But by using the Following script all the worksheets are getting updated.
I want it to updated in selected worksheet and only selected columns like J, K or L.(columns)
Please help me out with this problem.
Sorry if i am missing something here but why don't you just select the column and do Ctrl+h (replace) and in find, write '*-' (without quotes) and click replace all, without writing anything in the replace with field.
I don't understand the need of a macro. Again, apologies if i am missing something here.
This will restrict the replacement to the active sheet, columns J thru L:
Sub Update()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Worksheet, ur As Range, r As Range
Set ur = Range("J:L").Cells.SpecialCells(xlCellTypeConstants)
For Each r In ur
If InStr(1, r.Value, "-") > 0 Then
r.Value = Split(r.Value, "-")(1)
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
You'll need to take out the for loop over all the worksheets and pick a range that is only a desired column, not the whole used part of the sheet as it current it. A basic way of doing it:
Sub Update()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Worksheet, ur As Range, r As Range
Set ws = ActiveSheet
Set ur = ws.Range(A:A) ' sets the range as a whole column with the chosen letter
For Each r In ur
On Error Resume Next
r = Split(r, "-")(1)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
You'll just have to replace A:A in the code with whatever column you want e.g. G:G for column G. Depends how exactly you want to picking your columns while using this code.