Scribd
Upload
260 views9 pages

VBA Code Check Given Number Is Wheather Prime or Not

The document contains code snippets in VBA for various tasks like: 1) Checking if a number is prime or not. 2) Finding the second highest value in a range. 3) Summing values by cell color. 4) Deleting blank cells.

Uploaded by

Dashrath Bhadangkar
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
260 views9 pages

VBA Code Check Given Number Is Wheather Prime or Not

The document contains code snippets in VBA for various tasks like: 1) Checking if a number is prime or not. 2) Finding the second highest value in a range. 3) Summing values by cell color. 4) Deleting blank cells.

Uploaded by

Dashrath Bhadangkar
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/ 9

VBA Code check Given number is wheather Prime or Not

Dim divisors As Integer, number As Long, i As Long


divisors = 0
number = InputBox("Enter a number")
For i = 1 To number
If number Mod i = 0 Then
divisors = divisors + 1
End If
Next i
If divisors = 2 Then
MsgBox number & " is a prime number"
Else
MsgBox number & " is not a prime number"
End If
VBA Code to Find Second Highest
Dim rng As Range, cell As Range
Dim highestValue As Double, secondHighestValue As Double
Set rng = Selection
highestValue = 0
secondHighestValue = 0
For Each cell In rng
Next cell
If cell.Value > highestValue Then highestValue = cell.Value
For Each cell In rng
Next cell
If cell.Value > secondHighestValue And cell.Value < highestValue Then
secondHighestValue = cell.Value
MsgBox "Second Highest Value is " & secondHighestValue

VBA Code to Sum By Color


Dim toReceive As Integer, i As Integer
toReceive = 0

For i = 1 To 12
If Cells(i, 1).Font.Color = vbRed Then
toReceive = toReceive + Cells(i, 1).Value
End If
Next i
MsgBox "Still to receive " & toReceive & " dollars"

VBA Code to Deleter Blank Cells


Dim counter As Integer, i As Integer
counter = 0
For i = 1 To 10
If Cells(i, 1).Value <> "" Then
Cells(counter + 1, 2).Value = Cells(i, 1).Value
counter = counter + 1
End If
Next i

VBA Code for operating on Range of Values (Dynamic Range)


Dim rng As Range, cell As Range
Set rng = Range("A1:A3")
For Each cell In rng
cell.Value = cell.Value * cell.Value
Next cell
Set rng = Range("A1:A3")
Set rng = Selection

VBA CODE to Loop through Entire Column


Dim i As Long
Columns(1).Font.Color = vbBlack
For i = 1 To Rows.Count
If Cells(i, 1).Value < Range("D2").Value And Not IsEmpty(Cells(i, 1).Value) Then
Cells(i, 1).Font.Color = vbRed
End If
Next i

Do Until Loop
Dim i As Integer
i=1
Do Until i > 6
Cells(i, 1).Value = 20
i=i+1
Loop

Sort Numbers
Dim i As Integer, j As Integer, temp As Integer, rng As Range
Set rng = Range("A1").CurrentRegion
For i = 1 To rng.Count
For j = i + 1 To rng.Count
If rng.Cells(j) < rng.Cells(i) Then
End If
temp = rng.Cells(i)
rng.Cells(i) = rng.Cells(j)
rng.Cells(j) = temp
Next j
Next i

Randomly Sort Data


For i = 1 To 5
Cells(i, 2).Value = WorksheetFunction.RandBetween(0, 1000)
Next i
For i = 1 To 5
For j = i + 1 To 5
If Cells(j, 2).Value < Cells(i, 2).Value Then
tempString = Cells(i, 1).Value
Cells(i, 1).Value = Cells(j, 1).Value
Cells(j, 1).Value = tempString
tempInteger = Cells(i, 2).Value
Cells(i, 2).Value = Cells(j, 2).Value
Cells(j, 2).Value = tempInteger
End If
Next j
Next i

Remove Duplicates
Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer
Cells(1, 2).Value = Cells(1, 1).Value
uniqueNumbers = 1
toAdd = True
For i = 2 To 10
For j = 1 To uniqueNumbers
If Cells(i, 1).Value = Cells(j, 2).Value Then
toAdd = False
End If
Next j
If toAdd = True Then
Cells(uniqueNumbers + 1, 2).Value = Cells(i, 1).Value
uniqueNumbers = uniqueNumbers + 1
End If
toAdd = True
Next i

Separate Strings
Dim fullname As String, commaposition As Integer, i As Integer
For i = 2 To 7
fullname = Cells(i, 1).Value
commaposition = InStr(fullname, ",")
Cells(i, 2).Value = Mid(fullname, commaposition + 2)
Cells(i, 3).Value = Left(fullname, commaposition - 1)
Next i

Reverse Strings
Dim text As String, reversedText As String, length As Integer, i As Integer
text = InputBox("Enter the text you want to reverse")
length = Len(text)
For i = 0 To length - 1
reversedText = reversedText & Mid(text, (length - i), 1)
Next i
msgbox reversedText

Convert to Proper Case


Dim rng As Range, cell As Range
Set rng = Selection
For Each cell In rng
If Not cell.HasFormula Then
cell.Value = WorksheetFunction.Proper(cell.Value)
End If
Next cell

Reverse Strings
Dim text As String, reversedText As String, length As Integer, i As Integer
text = InputBox("Enter the text you want to reverse")
length = Len(text)
For i = 0 To length - 1
reversedText = reversedText & Mid(text, (length - i), 1)
Next i
msgbox reversedText

Convert to Proper Case


Dim rng As Range, cell As Range
Set rng = Selection
For Each cell In rng
If Not cell.HasFormula Then
cell.Value = WorksheetFunction.Proper(cell.Value)
End If Next cell

Count Words
Dim rng As Range, cell As Range
Dim cellWords, totalWords As Integer, content As String
Set rng = Selection
cellWords = 0
totalWords = 0
For Each cell In rng
If Not cell.HasFormula Then
content = cell.Value
content = Trim(content)

End If

Next cell
If content = "" Then
cellWords = 0
Else
cellWords = 1
End If
Do While InStr(content, " ") > 0
content = Mid(content, InStr(content, " "))

Loop
content = Trim(content)
cellWords = cellWords + 1
totalWords = totalWords + cellWords
MsgBox totalWords & " words found in the selected range."

The DateDiff function in Excel VBA can be used to get the number of days between
two dates.
Place a command button on your worksheet and add the following code lines:
Dim firstDate As Date, secondDate As Date, n As Integer
firstDate = DateValue("Jun 19, 2010")
secondDate = DateValue("Jul 25, 2010")
n = DateDiff("d", firstDate, secondDate)
MsgBox n

Weekdays
Dim date1 As Date, date2 As Date, dateToCheck As Date
Dim daysBetween As Integer, weekdays As Integer, i As Integer
weekdays = 0
date1 = Range("B2")
date2 = Range("B3")
daysBetween = DateDiff("d", date1, date2)
For i = 0 To daysBetween
dateToCheck = DateAdd("d", i, date1)
If (Weekday(dateToCheck) <> 1 And Weekday(dateToCheck) <> 7) Then
weekdays = weekdays + 1
End If
Next i
MsgBox weekdays & " weekdays between these two dates"

Delay a Macro

Sub reminder()
Application.OnTime Now() + TimeValue("00:00:05"), "reminder"
Application.OnTime TimeValue("14:00:00 am"), "reminder"
MsgBox "Don't forget your meeting at 14.30"
End Sub

Year Occurrences
Dim yearCount As Integer, yearAsk As Integer, i As Integer
yearCount = 0
yearAsk = Range("C4").Value
For i = 1 To 16
If year(Cells(i, 1).Value) = yearAsk Then
yearCount = yearCount + 1
End If
Next i
MsgBox yearCount & " occurrences in year " & yearAsk

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy