Scribd
Upload
152 views6 pages

Useful Excel VBA Codes

This document provides several VBA code examples for: 1. Automatically formatting cell text as uppercase, lowercase, or proper case on worksheet change. 2. A macro that loops through a range to convert cell text to uppercase. 3. Code that converts the selected range to uppercase only when edited cells are within a specified range. 4. Sub procedures to center and size text and paste values only to visible cells. 5. A sort macro to sort data in descending order based on a selected column range. 6. Additional code examples for common tasks like filling blank cells, removing fixed object errors, and enabling insert/delete functionality.

Uploaded by

Nimesh
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
152 views6 pages

Useful Excel VBA Codes

This document provides several VBA code examples for: 1. Automatically formatting cell text as uppercase, lowercase, or proper case on worksheet change. 2. A macro that loops through a range to convert cell text to uppercase. 3. Code that converts the selected range to uppercase only when edited cells are within a specified range. 4. Sub procedures to center and size text and paste values only to visible cells. 5. A sort macro to sort data in descending order based on a selected column range. 6. Additional code examples for common tasks like filling blank cells, removing fixed object errors, and enabling insert/delete functionality.

Uploaded by

Nimesh
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 6

TO AUTO CORRECT THE CASE – VBA CODE

UPPER CASE

Private Sub Worksheet_Change(ByVal Target As Range)


'Update 20140603
Target.Value = VBA.UCase(Target.Value)
End Sub

LOWER CASE

Private Sub Worksheet_Change(ByVal Target As Range)


'Update 20140603
Target.Value = VBA.LCase(Target.Value)
End Sub

PROPER CASE

Private Sub Worksheet_Change(ByVal Target As Range)


'Update 20140603
Target.Value = Application.WorksheetFunction.Proper(Target.Value)
End Sub

UPPER CASE MACRO – VBA CODE

(1.) Sub Uppercase()


' Loop to cycle through each cell in the specified range.
For Each x In Range("A1:M1000")
' Change the text in the range to uppercase letters.
x.Value = UCase(x.Value)
Next
End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'Change A1:A10 to the range you desire


'Change UCase to LCase to provide for lowercase instead of uppercase

If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then


Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
End Sub
{{
‘To call Sub Procedure to Center and Apply
Sub main()
Call Format_Centered_And_Sized( arg1, arg2, ... )
End Sub

‘Sub Procedure to Center and Apply a Supplied Font Size to the Selected Range
Sub Format_Centered_And_Sized(Optional iFontSize As Integer = 10)
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.Font.Size = iFontSize
End Sub
}}

VBA: Paste values to visible cells only.

Sub CopyFilteredCells()
    'Updateby20150203
    Dim rng1 As Range
    Dim rng2 As Range
    Dim InputRng As Range
    Dim OutRng As Range
    xTitleId     = "KutoolsforExcel"
    Set InputRng = Application.Selection
    Set InputRng = Application.InputBox("Copy Range :", xTitleId,
InputRng.Address, Type: = 8)
    Set OutRng   = Application.InputBox("Paste Range:", xTitleId, Type: = 8)
    For Each rng1 In InputRng
        rng1.Copy
        For Each rng2 In OutRng
            If rng2.EntireRow.RowHeight > 0 Then
                rng2.PasteSpecial
                Set OutRng = rng2.Offset(1).Resize(OutRng.Rows.Count)
                Exit For
            End If
        Next
    Next
    Application.CutCopyMode = False
End Sub
VBA CODE TO SORT TABLE ACCORDINGLY SELECTED COLUMN RANGE

Sub sbSortDataInExcelInDescendingOrder()

Dim strDataRange, strkeyRange As String


strDataRange = "A2:I17"
strkeyRange = "I2:I17"
With Sheets("Sheet1").Sort
.SortFields.Clear
.SortFields.Add _
Key:=Range(strkeyRange), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal

.SetRange Range(strDataRange)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

UPPER CASE VBA CODE (Fully Working with copy & paste also)

Private Sub Worksheet_Change(ByVal Target As Range)


Dim cell As Range
On Error Resume Next
Application.EnableEvents = False
For Each cell In Target
cell = UCase(cell)
Next
Application.EnableEvents = True
End Sub
UPPER CASE VBA CODE (Fully Working with copy & paste also)With
range option

Private Sub Worksheet_Change(ByVal Target As Range)

''''''''''''''''''''''''''''''''''''''''''''

'Forces text to UPPER case for the range A1:B20

''''''''''''''''''''''''''''''''''''''''''''

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next

If Not Intersect(Target, Range("A1:B20")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

On Error GoTo 0

End Sub
FILL IN THE BLANK CELLS IN SELECTED RANGE

Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = InputBox("Enter value that will fill empty cells in
selection", _
"Fill Empty Cells")
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub

REMOVE FIXED OBJECT MOVE ERROR


Option Explicit
Sub fixedobjecterror()
Dim wksht As Excel.Worksheet
Dim cmt As Object
Dim wb As Excel.Workbook
Set wb = ActiveWorkbook

For Each wksht In wb.Worksheets


For Each cmt In wksht.Comments
cmt.Shape.Placement = xlMoveAndSize
Next cmt
Next wksht

End Sub
Option Explicit
Sub EnableInsertDeleteRowsCols()
Dim ctrl As CommandBarControl
''
'Disable "Row" Delete.
For Each ctrl In Application.CommandBars.FindControls(ID:=293)
ctrl.Enabled = True
Next ctrl
'Disable "Column" Delete.
For Each ctrl In Application.CommandBars.FindControls(ID:=294)
ctrl.Enabled = True
Next ctrl
''
'Disable "Row" and "Column" Insert.
For Each ctrl In Application.CommandBars.FindControls(ID:=3183)
ctrl.Enabled = True
Next ctrl
''
'Disable "Cell" Delete.
For Each ctrl In Application.CommandBars.FindControls(ID:=292)
ctrl.Enabled = True
Next ctrl
'Disable "Cell" Insert.
For Each ctrl In Application.CommandBars.FindControls(ID:=3181)
ctrl.Enabled = True
Next ctrl
End Sub

To disable control put .Enable=False

You might also like