How could I change this code so I don't have to first select all the cells? I would like this to work without selecting the cells first, instead, it should work with the worksheet("Phase").
Option Explicit
Sub RemoveFormats()
'Remove all formatting except changes in font and font size
'Turn off screen updates to improve performance
Application.ScreenUpdating = False
With Selection
'Remove cell colors
.Interior.ColorIndex = xlNone
'Remove all cell borders
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
'Remove all special font properties and formatting
With .Font
.FontStyle = "Regular"
.Strikethrough = False
.Superscript = False
.Subscript = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
'Restore screen updates to display changes
Application.ScreenUpdating = True
End Sub
If you are talking about applying your macro to the entire sheet called "Phase", you would simply reference the Worksheet.Cells instead of the Selection object property to get all cells of a worksheet.
Sub YourMethod()
'// code...
With ThisWorkbook.Worksheets("Phase").Cells
'Remove cell colors
.Interior.ColorIndex = xlNone
'// more code....
End With
end Sub
Related
In my worksheet, I have a table with buttons to add or erase a line below the last filled line. (It copies a range of pre-filled data and formatting from another sheet, or erases it - I don't delete the row in case it would mess with my other sheets).
When I copy the data it updates the table range, but when I erase it, it doesn't... so when I copy a new one, it skips a line.
This is the delete sub:
Sub DeleteLastLine()
'
' DeleteLastLine Macro
'
'
Sheets("Cadastro Geral").Select
Range("A" & Rows.Count).End(xlUp).EntireRow.Select 'I WOULD HAVE TO EITHER FIND A WAY TO SELECT THE LAST CELL WITH CONTENT IGNORING THE TABLE RANGE'
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Dim tbl As ListObject
'OR FIND A WAY TO DYNAMICALLY RESIZE THE RANGE OF MY TABLE. NOW IT GOES FROM A3:AI913... TOMORROW IT MIGHT BE AT A3:AI950
Range("A" & Rows.Count).End(xlUp).Select
End Sub
The VBA Code below, which is part of a much larger sub that pulls and formats data from various other sheets, is formatting the first row, Range A1:I1 which contains headers.
It appears to work as expected but is there a simpler or more efficiant way of
doing exactly what this code is doing?
Do I really need to include things such as:
.Strikethrough = False
.Superscript = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
and so on or is it best practice to include them, I would rather do things the correct way.
Rows("1:1").RowHeight = 32
Range("A1:I1").Select
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("A1").Select
End Sub
Formatting Cells
Here's what I think is important in your particular case. But some of it may depend on the previous formatting.
It's best to test on your own. Remove some rows that seem to contain default values. Study those various properties.
Option Explicit
Sub testFormatting()
With Rows(1)
.RowHeight = 32
With .Columns("A:I")
With .Font
.Name = "Arial"
.Size = 11
.ThemeColor = xlThemeColorDark1
End With
.Interior.ThemeColor = xlThemeColorLight1
End With
End With
End Sub
As far as doing things the correct way, never use .Select but instead use direct referencing
Dim r as Range
Set r = Range("A1").Resize(1,9) ' Reference to A1:I1
r.EntireRow.RowHeight = 32
With r.Font
.Name = "Arial"
' ...
End With
and so on
It is convenient to make your own style (programmatically or manually) and apply to cells:
Sub createHeaderStyle() ' or create the style by UI
Dim st As Style
Set st = ThisWorkbook.Styles.Add("headerStyle")
With st
.Font.Bold = True
'... and so on
End With
End Sub
' application
Sub applyStyle(rng As Range)
rng.Style = "headerStyle"
End Sub
Subsequently, you can interactively edit the style properties
I'm having trouble trying to use with instead of .select when writing code to insert a new row. I have been told multiple times that .select is not to be used as it is much slower.
My macro creates a new row but deletes the contents in the row below and copies the formatting of the row above which never happened when I was using .select. This also means that the increasing number in cell B11 is not correct as it starts again from 1 due to the cleared contents below.
Sub New_Entry()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim rng As Range
Set rng = Range("B11:AB11")
With rng
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
Application.CutCopyMode = False
With rng
.ClearContents
.Interior.ColorIndex = xlNone
.Borders.LineStyle = xlContinuous
End With
With Range("B11")
.Value = Range("B12") + 1
End With
With rng
.Font.Bold = False
.Font.ColorIndex = xlAutomatic
.Font.TintAndShade = 0
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Any help would be appreciated, thanks!
As far as I can see you have two questions:
1. Why does this delete the content?
That is because your With rng takes Set rng = Range("B11:AB11") and does .ClearContents to it at the same time as it inserts a row.
You can check this by switching around the order of your code.
All With statements with the same condition always run at the same time.
2. Why is the formatting copied?
The format isn't actually copied, you are formatting every line you create with .Borders.LineStyle = xlContinuous.
This should work:
Sub New_Entry()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim rng As Range
Set rng = Range("B11:AB11")
With rng
'.ClearContents
.Interior.ColorIndex = xlNone
'.Borders.LineStyle = xlContinuous
'End With
'With rng
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
Application.CutCopyMode = False
With Range("B11")
.Value = Range("B12") + 1
End With
With rng
.Font.Bold = False
.Font.ColorIndex = xlAutomatic
.Font.TintAndShade = 0
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
.Select is slower because it runs code line by line.
The range "rng" seems to shift down after the insert. Here is the route I would take:
Sub New_Entry()
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("B11:AB11").Insert Shift:=xlDown
Range("B11").Value = Range("B12") + 1
With Range("B11:AB11")
.Interior.ColorIndex = xlNone
.Borders.LineStyle = xlContinuous
.Font.Bold = False
.Font.ColorIndex = xlAutomatic
.Font.TintAndShade = 0
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I'm looking for an excel Macro that will set all the cell fills to no fill and make all cells have no borders. I have multiple spreadsheets in my workbook and want this to apply to all of them. I've looked all through the internet looking for something that does this, but came up short.
This should do it. Just add it to any sub and you're good to go:
Dim wsCount As Integer
Dim i As Integer
wsCount = ActiveWorkbook.Worksheets.Count
For i = 1 to wsCount
Worksheets(i).Activate
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Next i
I am using the following subroutine to combine multiple Excel files from a single folder into a single workbook with multiple worksheets.
Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\MyPath" ' <-- Insert Absolute Folder Location
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The end product is an excel file with multiple worksheets (as well as one blank Sheet 1). I was wondering how I can then apply another macro to this newly created Workbook. As an example, I wish for all the worksheets within this new workbook to have their Headers bold and coloured a certain way, and to have the empty Worksheet deleted.
eg:
Sub Headers()
Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sheets.Select 'selects all sheets'
Rows("1:1").Select
Selection.Interior.ColorIndex = 37
Add a parameter to Headers that specifies a sheet, then call the sub somewhere in the Do Loop after the copy, like:
Call Headers(wbDst.Worksheets(wbDst.Worksheets.Count))
with your second sub looking like this:
Sub Headers(workingSheet As Worksheet)
workingSheet.Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.
.
.
This code will do the following:
1) First, delete Sheet1 as you asked for in your post
2) Format the top row in the remaining sheets
Sub Headers()
Dim wkSheet As Worksheet
//Delete Sheet1. Note that alerts are turned off otherwise you are prompted with a dialog box to check you want to delete sheet1
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = False
//Loop through each worksheet in workbook sheet collection
For Each wkSheet In ActiveWorkbook.Worksheets
With wkSheet.Rows("1:1")
.Interior.ColorIndex = 37
//Add additional formatting requirements here
End With
Next
End Sub