Scribd
Upload
3 views

Excel Useful Macro

The document provides a series of VBA code snippets for Excel to perform various tasks such as removing time from dates, converting formulas to values, inserting rows, deleting empty rows and columns, and trimming spaces. It also includes a function to create QR codes based on a given text. Each code snippet is accompanied by a brief explanation of its purpose and usage.

Uploaded by

Wafy
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
3 views

Excel Useful Macro

The document provides a series of VBA code snippets for Excel to perform various tasks such as removing time from dates, converting formulas to values, inserting rows, deleting empty rows and columns, and trimming spaces. It also includes a function to create QR codes based on a given text. Each code snippet is accompanied by a brief explanation of its purpose and usage.

Uploaded by

Wafy
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 6

Content update

1. Delete time from date


2. mengubah formula ke dalam value
3. menyisipkan row di setiap row dalam range
4. delete row atau kolom kosong
5. delete Space kosong di antara string/value
1. Remove time from date
1. Select the range that you want to remove the time.

2. Click Developer>Visual Basic or press Alt + F11, a new Microsoft Visual Basic
for applications window will be displayed, click Insert>Module, and input the following
code into the Module:
VBA: Remove time from date.

Sub ConvertDates()
'Updateby20140529
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address,
Type:=8)
For Each Rng In WorkRng
Rng.Value = VBA.Int(Rng.Value)
Next
WorkRng.NumberFormat = "dd/mm/yyyy"
End Sub

3. Then click button to run the code. And a dialog pops out for selecting a range to remove
the time from date. See screenshot:
Click OK, and all of the time in selection have been deleted and the date format also have been
set.

2. Convert All Formulas into Values


'This code will convert all formulas into values
Sub ConvertToValues()
With ActiveSheet.UsedRange
.Value = .Value
End With
End Sub

3. Insert A Row After Every Other Row in the Selection


'This code will insert a row after every row in the selection
Sub InsertAlternateRows()
Dim rng As Range
Dim CountRow As Integer
Dim i As Integer
Set rng = Selection
CountRow = rng.EntireRow.Count
For i = 1 To CountRow
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
Next i
End Sub
4. Delete empty rows and columns
Blank rows in Excel are a problem with data processing. Here is how to get rid of
them:
Sub DeleteEmptyRowsAndColumns()

'Declare your variables.

Dim MyRange As Range

Dim iCounter As Long

'Define the target Range.

Set MyRange = ActiveSheet.UsedRange

'Start reverse looping through the range of Rows.

For iCounter = MyRange.Rows.Count To 1 Step -1

'If entire row is empty then delete it.

If Application.CountA(Rows(iCounter).EntireRow) = 0 Then

Rows(iCounter).Delete

'Remove comment to See which are the empty rows

'MsgBox "row " & iCounter & " is empty"

End If

'Increment the counter down

Next iCounter

'Step 6: Start reverse looping through the range of Columns.

For iCounter = MyRange.Columns.Count To 1 Step -1

'Step 7: If entire column is empty then delete it.

If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then

Columns(iCounter).Delete

End If

'Step 8: Increment the counter down

Next iCounter
End Sub

5. Remove empty spaces


Sub TrimTheSpaces()

'Declare your variables

Dim MyRange As Range

Dim MyCell As Range

'Save the Workbook before changing cells

Select Case MsgBox("Can't Undo this action. " & _

"Save Workbook First?", vbYesNoCancel)

Case Is = vbYes

ThisWorkbook.Save

Case Is = vbCancel

Exit Sub

End Select

'Define the target Range.

Set MyRange = Selection

'Start looping through the range.

For Each MyCell In MyRange

'Trim the Spaces.

If Not IsEmpty(MyCell) Then

MyCell = Trim(MyCell)

End If

'Get the next cell in the range

Next MyCell

End Sub
Make QR Code

Funtion Buat_QR(codetext As String)

Dim URL As String, MyCell As Range

Set MyCell = Application.Caller

URL = "https://chart.googleapis.com/chart?chs=125x125&cht=qr&chl=" & codetext

On Error Resume Next

ActiveSheet.Pictures("MyQR_" & MyCell.Address(False, False)).Delete

On Error GoTo 0

ActibeSheet.Pictures.Insert(URL).Select

With Selection.ShapeRange(1)

.PictureFormat.CropLeft = 15

.PictureFormat.CropRight = 15

.PictureFormat.CropTop = 15

.PictureFormat.CropBottom = 15

.Name = "MyQR_" & MyCell.Address(False, False)

.Left = MyCell.Left + 25

.Top = MyCell.Top + 5

End With

Buat_QR = "" 'Entry Text as Optional

End Function

End Sub

You might also like