VB Script-Excel Macro


       Objects
      the Excel application (the largest object)
      a workbook
      a worksheet
      a range
      a chart
      a legend
       Methods
      Activate
      Clear
      Copy
      Cut
      Delete
      Select
       The syntax of many statements in Visual Basic is
      Object.Method
      Range("B3").Select
       Properties
      ColumnWidth
      Font
      Formula
      Text
      Value
       A property can be thought of as being somewhat similar to an adjective. It is set using a statement of the form
      Object.Property = value
      ActiveCell.FormulaR1C1 = "D.Morgan“
      Range("C3").ColumnWidth = 14
       Variables
      For example, the following statement assigns the value 34 to the variable x.
       x = 34
      In the example below, variables myl and myw are given initial values. These are then used in a calculation.
       myl = 34
       myw = 15
       myarea = myl*myw
       Using Dim
      Dim variablename As datatype
       Example Dim Statement
       Sub example()
                       Dim myint As Integer
                       myint = 5
       End Sub
       Dim marks, c, d
      Set marks = Range("A1:B10")
      d = 0
      For Each c in marks
      If c.Value < 40 Then
      d = d+1
      End If
      Next c 

Macro actions can not be reversed or undo impossible

Please take back copy of the file before you execute the macros

Sample Macro Codes: (Copy the codes to your excel VBA environment to use the macros)

Sub ShadeEveryOtherRow()
    Dim Counter As Integer

    'For every row in the current selection...
    For Counter = 1 To Selection.Rows.Count
        'If the row is an odd number (within the selection)...
        If Counter Mod 2 = 1 Then
            'Set the pattern to xlGray16.
            Selection.Rows(Counter).Interior.Pattern = xlGray16
        End If
    Next

End Sub
'----------------------------------------------------------------------------


Sub Change_FormatHeader()
    ActiveSheet.PageSetup.CenterHeader = Format(Now, "MMM DD, YYYY")
End Sub
'----------------------------------------------------------------------------


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


Sub Proper_Case()
   ' Loop to cycle through each cell in the specified range.
   For Each x In Range("C1:C5")
      ' There is not a Proper function in Visual Basic for Applications.
      ' So, you must use the worksheet function in the following form:
      x.Value = Application.Proper(x.Value)
   Next
End Sub
'----------------------------------------------------------------------------

Sub sskformat
k = Worksheets.Count
    For i = 1 To k
    If Worksheets(k - i + 1).Visible Then
    Worksheets(k - i + 1).Select
    Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select

    Range("A2").Select
    Selection.Columns.AutoFit
    Range("A1").Select
    Selection.Columns.AutoFit
    Range("C5").Select
    Selection.Columns.AutoFit
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "SSK says go"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "SSK says good Morning"
    Range("G5").Select
    
    End If
Next i
End Sub
'----------------------------------------------------------------------------


Sub NormalPosition()
' Select top cell for all sheets
' Visual improvement for your documents
k = Worksheets.Count
For i = 1 To k
  If Worksheets(k - i + 1).Visible Then
    Worksheets(k - i + 1).Select
    Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If
Next i
End Sub
'----------------------------------------------------------------------------


Sub FormulasToValues()
'
' Replace all formulas with values
'

WCount = Worksheets.Count
For i = 1 To WCount
  If Worksheets(WCount - i + 1).Visible Then
    Worksheets(WCount - i + 1).Select
    RCount = ActiveCell.SpecialCells(xlLastCell).Row
    CCount = ActiveCell.SpecialCells(xlLastCell).Column
    For j = 1 To RCount
      For k = 1 To CCount
        Worksheets(WCount - i + 1).Cells(j, k) = Worksheets(WCount - i + 1).Cells(j, k).Value
      Next k
    Next j
  End If
Next i

End Sub
'----------------------------------------------------------------------------

Sub DeleteHiddenSheets()
'
' Remove hidden sheets from your document
'

i = 1
While i <= Worksheets.Count
  If Not Worksheets(i).Visible Then
    Worksheets(i).Delete
  Else
    i = i + 1
  End If
Wend

End Sub
'----------------------------------------------------------------------------

Sub DeleteHiddenRows()
'
' Remove hidden rows from all sheets
'

For i = 1 To Worksheets.Count
  If Worksheets(i).Visible Then
    Worksheets(i).Select
    ActiveCell.SpecialCells(xlLastCell).Select
    k = ActiveCell.Row
    For j = 1 To k
      If Rows(j).Hidden Then
        Rows(j).Hidden = False
        Rows(j).Delete
      End If
    Next j
  End If
Next i
If Worksheets(1).Visible Then Worksheets(1).Select

End Sub
'----------------------------------------------------------------------------

Sub Combine2coulumnto3()
'Have x start at row 3
x = 3
'Loop until a blank row is found
Do While Cells(x, 3).Value <> ""
    'This will put the values of the
    'third and fourth columns(C and D)
    'together with a space between them
    'in the fifth column(E)
    Cells(x, 5).Value = Cells(x, 3).Value + " " + Cells(x, 4).Value
    'increase the value of x by 1
    'to act on the next row
    x = x + 1
Loop
End Sub
'----------------------------------------------------------------------------

Sub Setbackgroundcolorrange()
    'Tell VBA that the MyCell variable is a range
    Dim MyCell As Range
    For Each MyCell In Selection
        If MyCell.Value Like "*Book*" Then
            'Set the Cell Background color to green
        MyCell.Interior.ColorIndex = 4

        ElseIf MyCell.Value = " " Then
            'Clear the cell back ground color
        MyCell.Interior.ColorIndex -xlNone
        Else
            'Set the cell background color to blue
        MyCell.Interior.ColorIndex = 5

        End If
    Next

End Sub
'----------------------------------------------------------------------------

Sub Deleteduplicate()

    'Loop to delete duplicates - nested loops
    'Start at the currently selected cell

    x = ActiveCell.Row

    y = x + 1

    Do While Cells(x, 4).Value <> ""

        Do While Cells(y, 4).Value <> ""

        'Test for duplication;
        'If the values of the fourth column (D)
        'and the sixth column (F) match in
        'two rows, delete the second row of the pair
        'otherwise go to the next row until the end

    If (Cells(x, 4).Value = Cells(y, 4).Value) And (Cells(x, 6).Value = Cells(y, 6).Value) Then
        Cells(y, 4).EntireRow.Delete

    Else

        y = y + 1
    End If

        Loop
        'increase the value of x by 1 to move
        'the loop starting point to the next row
        x = x + 1
        'reset y so it start at the next row
        y = x + 1
    Loop

End Sub

'----------------------------------------------------------------------------

Excel Macro Basics Reference Book

No comments:

Post a Comment