ritesh code reference

  Private Sub myCalc(Getvalue As Double, myPercent)          Getvalue = Getvalue * myPercent     MsgBox Getvalue      End Sub Public Sub GetMyValue()     Dim myValue As Double     Dim p As Variant     'assign value and percentage from cell     myValue = Range("A8").Value     p = Range("B8").Value     Call myCalc(myValue, p)     MsgBox myValue      End Sub ========================================================================= Private Sub myCalc(Getvalue As Double, myPercent)          Getvalue = Getvalue * myPercent     MsgBox Getvalue      End Sub Public Sub GetMyValue()     Dim myValue As Double     Dim p As Variant     'assign value and percentage from cell     myValue = Range("A8").Value     p = Range("B8").Value     If Excel.WorksheetF...

 Project Activity Show top 3 value Dim myRange As Range Dim Top1 As Double, Top2 As Double, Top3 As Double Dim msg As Long On Error GoTo leave Set myRange = Application.InputBox(Prompt:="Select the range of no to get top 3 values", _ Title:="Top3..", Type:=8) If Application.WorksheetFunction.Count(myRange) > 2 Then     Top1 = Excel.WorksheetFunction.Large(myRange, 1)     Top2 = Excel.WorksheetFunction.Large(myRange, 2)     Top3 = Excel.WorksheetFunction.Large(myRange, 3)          msg = MsgBox _     (Prompt:="Here is the top three values" & vbNewLine & "Top1" _     & " " & Top1 & vbNewLine & "Top2" & " " & Top2 & _     vbNewLine & "Top3" & " " & Top3, _     Title:="Here is the Top 3 values", Buttons:=vbOKOnly) Else MsgBox "please select at least 3 cells with numbers", vbInformation leave: End If End Sub

 Task 1 - Add data , add Amount  Sub Excel_InputBox() Dim Cname As String Dim NextRow As Long Dim CAmount As Long Cname = InputBox("CustomerName", "Name Please..") NextRow = Cells(Rows.Count, 1).End(xlUp).Row+ 1 Range("A" & NextRow).Value = Cname CAmount = Excel.Application _ .InputBox(Prompt:="Please Input Amount", Title:="Amount..", Type:=1) Range("B" & NextRow).Value = CAmount Debug.Print NextRow End Sub Task 2 : Identify Blank Cells Sub Excel_InputBox_Range() Dim myRange As Range Dim cellBlank As Long, cellNum As Long, cellOther As Long On Error GoTo leave Set myRange = Application.InputBox("Count the number of cells", "Checking Cells...", , , , , , 8) 'Debug.Print myRange.Address cellBlank = Excel.WorksheetFunction.CountBlank(myRange) cellNum = Excel.WorksheetFunction.Count(myRange) cellOther = Excel.WorksheetFunction.CountA(myRange) - cellNum MsgBox cellBlank & "cells are blank....

 Adding Title - input box Sub Simple_InputBox() Dim myinp As String myinp = VBA.Interaction. _ InputBox(prompt:="Please input Subtitle", Title:="Subtitle please ") If myinp = "" Then Exit Sub Range("A2").Value = Excel.WorksheetFunction.Proper(myinp) End Sub Input Box to add name in new line Sub VBA_InputBox() Dim Cname As String Dim NextRow As Long Cname = InputBox("CustomerName", "Name Please..") NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Range("A" & NextRow).Value = Cname Debug.Print NextRow End Sub

 some VBA Fuctions Sub VBA_Functions() Dim currentMonth As Long currentMonth = VBA.Month(VBA.Date) Range("B3").Value = currentMonth Range("B4").Value = VBA.MonthName(VBA.Month(VBA.Date)) Range("C5").Value = VBA.MonthName(Range("B5")) Range("B9").Value = VBA.IsEmpty(Range("A9")) Range("B10").Value = VBA.IsEmpty(Range("A10")) Range("B11").Value = VBA.IsEmpty(Range("A11")) Debug.Print TypeName(Range("B9").Value) Debug.Print TypeName(Range("B4").Value) End Sub

 VBA Vs Excel Worksheet Fuctions Sub VBA_Excel_Functions() With ShVEF .Range("B3").Value = VBA.DateTime.Date .Range("B6").Value = VBA.UCase(.Range("A6").Value) .Range("B7").Value = VBA.LCase(.Range("A7").Value) .Range("B8").Value = VBA.StrConv(.Range("A9").Value, vbProperCase) .Range("B9").Value = Excel.WorksheetFunction.Proper(.Range("A9").Value)      End With Dim myrange As Range Set myrange = Range("A13").CurrentRegion Debug.Print myrange.Address Range("B11").Value = Excel.WorksheetFunction.Max(myrange) End Sub

 ● Loop through text and extract text and numbers to separate cells Sub For_next_loop_in_text() Dim i As Long 'For looping inside each cell Dim numfound As Long Dim textfound As String Dim r As Long 'For looping through each row Dim lastrow As String lastrow = Range("A" & Rows.Count).End(xlUp).Row For r = StartRow To lastrow          myValue = Range("A" & r).Value     For i = 1 To VBA.Len(myValue)              If IsNumeric(VBA.Mid(myValue, i, 1)) Then          numfound = numfound & Mid(myValue, i, 1)               ElseIf Not IsNumeric(VBA.Mid(myValue, i, 1)) Then          textfound = textfound & Mid(myValue, i, 1)     End If               Next i     Range("H" & r).Value = numfound     Range("I" & r).Value = textfound     numfound = ...

  ● Simple For…Next to conditionally add values (10) to Quantities greater than 400  Public Sub Simple_For()  Dim i As Long  Dim lastrow As Long  Dim myValue As Double  Const StartRow As Byte = 10    lastrow = Range("A" & StartRow).End(xlDown).Row  For i = StartRow To lastrow  myValue = Range("F" & i).Value  If myValue > 400 Then Range("F" & i).Value = Range("F" & i).Value + 10  If myValue < 0 Then Exit For    Next i   End Sub

 GoTo Statement Sub Simple_GoTo() Range("D3").Value = "" If VBA.IsError(Range("B3").Value) Then GoTo GetOut Range("C3").Value = Range("B3").Value  Exit Sub  GetOut:     Range("D3").Value = "you have an error in the cell"     Range("C3").Value = ""    End Sub

 Case statement  Public Sub Simple_If() Dim myText As String myText = Range("B3").Value Select Case myText     Case 1 To 200         Range("C3").Value = "Good"     Case 0         Range("C3").Value = ""     Case Is > 200         Range("C3").Value = "Excellent"     Case Else         Range("C3").Value = "Bad" End Select End Sub

If then (Else , Else If ) for conditional Outcomes  Public Sub Simple_If() If Range("B3").Value <> "" Then Range("C3").Value = Range("B3").Value End If If Range("B4").Value > 0 And Range("B4").Value <= 400 Then Range("C4").Value = Range("B4").Value End If End Sub

 Public Sub Protect_All_Sheets()     Dim Sh As Worksheet     For Each Sh In ThisWorkbook.Worksheets     Sh.Protect     Debug.Print Sh.Name     Next Sh             End Sub Public Sub Un_Protect_All_Sheets() Dim Sh As Worksheet For Each Sh In ThisWorkbook.Worksheets Sh.Unprotect Debug.Print Next Sh End Sub

 With and ...And With for easier coding  Public Sub With_Change_Font()   Dim myRange As Range Set myRange = Range("A10", "A" & Cells(Rows.Count, 1).End(xlUp).Row) 'Debug.Print myRange.Address With myRange.Font .Name = "Arial" .Bold = True .Size = 14 End With End Sub Public Sub With_Reset_Font()   Dim myRange As Range Set myRange = Range("A10", "A" & Cells(Rows.Count, 1).End(xlUp).Row) 'Debug.Print myRange.Address With myRange.Font .Name = "Calibri" .Bold = False .Size = 11 End With End Sub

  Sub DeclaringVarible()     Dim LastRow As String, Data As String     Data = Range("A1").CurrentRegion.Cells(1.1).Value     LastRow = Rows.Count               Debug.Print LastRow     Debug.Print Data      End Sub

 Copy Resize Variably Sized Ranges Public Sub CopyResizeVariablySizedRanges()     'COPY RANGE FOR VARIABLE SIZED RANGES     Range("A4").CurrentRegion.Copy Range("J4")          'OR FIXED RANGE     Range("A4:E10").Copy Range("J4")          'PASTESPECIAL METHOD TO USE EXCELS PASTESPECIAL OPTIONS          Range("A4").CurrentRegion.Copy     Range("J20").PasteSpecial xlPasteValuesAndNumberFormats               'TO ADD MORE PASTE SPECIAL OPTION TO ADD A NEW LINE     Range("J20").PasteSpecial xlPasteComments          'USE THE RESIZE PROPERTY TO RETURN A CHANGED RANGE     Range("A4").CurrentRegion.Offset(1, 0).Resize(Range("A4").CurrentRegion.Rows.Count - 1).Copy Range("A20")                End Sub

 Methods to find last Row Public Sub MethodsToFindLastRow() 'USE END PROPERTIES OF RANGE OBJEct Range("K6").Value = Cells(Rows.Count, 1).End(xlUp).Row 'OR Range("K6").Value = Range("A4").End(xlDown).Row 'EXAMPLE FOR LAST COLUMN Range("K8").Value = Cells(4, Columns.Count).End(xlToLeft).Column 'USE THE CURRENT REGION PROPERTY OF RANGE OBJECT Range("K10").Value = Range("A4").CurrentRegion.Rows.Count 'USE SPECIALCELLS METHOD OF RANGE OBJECT Range("K11").Value = Cells.SpecialCells(xlCellTypeLastCell).Row 'USE USE RANGE PROPERTY OF WORKSHEET OBJECT Range("K12").Value = Application.ActiveSheet.UsedRange.Rows.Count End Sub

  Most Useful Range Properties Value Show the underlying value in a cell. This is the default property of the range object. Read / Write Cells Returns a cell or range of cells within a range object Read / Write End Returns the last cell of the range. Similar to Ctrl + ↓ or ↑ or → or ← Read-only Offset Returns a new range based on offset row & column arguments Read / Write Count Returns the number of cells in a range. Read-only Column / Row Returns the column / row number of a range. If you select more than one cell, column / row returns the first occurrence in the range. Read-only CurrentRegion Used with other properties such as .address returns the range of data Read-only EntireColumn / EntireRow Returns a range object that represents the entire row or column Read-only Resize Changes the size of the range by defining the rows & columns for resizing Address Shows the range address including the $ signs. Read-only Font Returns a font object that has other properties (e.g. bo...

 Referencing Workbooks

 Referencing Worksheets 

 Different Ways of Referencing Ranges ▪ Range () ▪ Cells property of the range object ▪ Offset ▪ Defined Names ▪ Reference entire rows ▪ Reference entire columns ▪ Autofit all columns Sub ReferToCell() ActiveSheet.Cells.Clear          Range("A1").Value = "1st" 'Cells(1,1)= "1st"     Range("A2:C2").Value = "2nd"     Range("A3,C3").Value = "3rd"     Range("A" & 4, "C" & 4).Value = "4rth"     Range("A5", "C5").Value = "5th"     Range("A6:C8").Cells(1, 2).Value = "6th"     Range("A1").Offset(7, 2).Value = "7th"     Range("A1:B1").Offset(8, 1).Value = "8th"     Range("LastOne").Value = "10th"      End Sub Referencing Entire Rows/Columns  Public Sub ReferencingEntireRowsColumns() Range("2:5").RowHeight = 30 'ROW 2,3,4&5 HAVE HEIGHT OF 30 Range("7:7,9:...

 Different Ways to declare Variables 

Different Ways to Write Cells Public Sub ReferToCells() Cells.Clear 'Range("A1").Value = "1st" 'Cells(1, 2) = "2nd" Range("A1:D1").Value = "1st" Range("A2:C2,E2:G2").Value = "2nd" Range("A3", "C3").Value = "3rd" Range("A4,C4").Value = "4rth" Range("A5", "C5") = "5th" Range("A" & 6, "C" & 6).Value = "6th" Range("A4:C7").Cells(4, 2).Value = "7th" Cells(1, 1).Offset(7, 2) = "8th" End Sub