//
you're reading...
Database, IT-Center

Excel : Macro VBA Tutorial

Run a Macro Every Time a Cell Value Changes in Excel

Several readers have asked questions which require Excel to run a section of macro every time a value changes in the Excel spreadsheet.

First, the improved method available only in XL97: Excel 97 has some new event handlers that allow a macro to be run every time a cell changes.

Let’s say that anytime a value greater than 100 is entered in column A, you want to format the cell next to it to be red.

  • Open the Visual Basic Edit (Tools>Macro>Visual Basic Editor)
  • In the left window, right click Sheet1 and select View Code.
  • At the top of the Book1 – Sheet1 Code dialog box, there are two dropdowns. From the left dropdown select Worksheet. From the right dropdown, select Change.
  • Enter the following lines of code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Target.Column = 1 Then
	ThisRow = Target.Row
	If Target.Value > 100 Then
	  Range("B" & ThisRow).Interior.ColorIndex = 3
	Else
	  Range("B" & ThisRow).Interior.ColorIndex = xlColorIndexNone
	End If
  End If
End Sub

Any time a value in a cell is changed, this macro will be run. The variable Target will tell you which cell and the new value of the cell. Surprisingly, using this method does not significantly slow down the process.

Note that the macro will stay active as long as the worksheet is open or until you run a macro with the following line in it:

Application.EnableEvents = False

In Excel 95/7.0: You need to use the OnEntry method. You specify a macro that you want to be run after any value is entered. In this case, the variable Application.Caller contains the address and value that changed. Enter the following in a new module:

Sub AutoOpen()
  Worksheets("Sheet1").OnEntry = "CheckIt"
End Sub

Sub CheckIt()
  If Application.Caller.Column = 1 Then
    ThisRow = Application.Caller.Row     If Application.Caller.Value > 100 Then
      Range("B" & ThisRow).Interior.ColorIndex = 3
    Else
      Range("B" & ThisRow).Interior.ColorIndex = xlColorIndexNone
    End If
  End If
End Sub

OnEntry checking will stay active until you run a macro with the following code:

Worksheets("Sheet1").OnEntry = False

GETTING VALUE FORM CELL

Public Sub check()
Dim RngLook4 As Range
Dim rngFound As Range
For Each RngLook4 In Range("AN1:AN100")
 Set rngFound = Cells.Find(What:=RngLook4.Value, After:=RngLook4, LookIn:=xlFormulas, _
 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
 MatchCase:=False, SearchFormat:=False)
 If Not rngFound Is Nothing Then
 If rngFound.Row > 1 Then

 If CDec(RngLook4.Value) < 0 Then
 MsgBox ("ada negatif di " & rngFound.Row)
 'Else
 'MsgBox ("aman")
 End If
 End If
 End If
Next RngLook4
End Sub
Public Sub checkNoRek()
Dim RngLook4 As Range
Dim rngFound As Range
For Each RngLook4 In Range("F1:F10000")
 Set rngFound = Cells.Find(What:=RngLook4.Value, After:=RngLook4, LookIn:=xlFormulas, _
 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
 MatchCase:=False, SearchFormat:=False)
 If Not rngFound Is Nothing Then
 If rngFound.Row > 1 Then

 If Mid(RngLook4.Value, 4, 2) = "30" Or Mid(RngLook4.Value, 4, 2) = "31" Then
 MsgBox ("rek Giro di " & rngFound.Row & " , No Rek :" & RngLook4.Value)
 'Else
 'MsgBox ("aman")
 End If
 End If
 End If
Next RngLook4
End Sub

 Use Find to select a cell

The examples below will search in column A of a sheet named “Sheet1”
for the inputbox value. Change the sheet name or range in the code to your sheet/range.

Tip: You can replace the inputbox with a string or a reference to a cell like this
FindString = “SearchWord”
Or
FindString = Sheets(“Sheet1”).Range(“D1”).Value

This will select the first cell in the range with the InputBox value.

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub


If you have more then one occurrence of the value this will select the last occurrence.

Sub Find_Last()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub


If you have date’s in column A then this example will select the cell with today’s date.

Sub Find_Todays_Date()
    Dim FindString As Date
    Dim Rng As Range
    FindString = CLng(Date)
    With Sheets("Sheet1").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox "Nothing found"
        End If
    End With
End Sub

 

Mark cells with the same value in column A in the B column

This example search in Sheets(“Sheet1”) in column A for every cell
with “ron” and use Offset to mark the cell in the column to the right.
Note: you can add more values to the array MyArr.

Sub Mark_cells_in_column()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim I As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Search for a Value Or Values in a range
    'You can also use more values like this Array("ron", "dave")
    MyArr = Array("ron")

    'Search Column or range
    With Sheets("Sheet1").Range("A:A")

        'clear the cells in the column to the right
        .Offset(0, 1).ClearContents

        For I = LBound(MyArr) To UBound(MyArr)

            'If you want to find a part of the rng.value then use xlPart
            'if you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "ron"

            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    'mark the cell in the column to the right if "Ron" is found
                    Rng.Offset(0, 1).Value = "X"
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

Color cells with the same value in a Range, worksheet or all worksheets

This example color all cells in the range Sheets(“Sheet1”).Range(“B1:D100”) with “ron”.
See the comments in the code if you want to use all cells on the worksheet.
I use the color index in this example to give all cells with “ron” the color 3 (normal this is red)

See this site for all the 56 index numbers
http://www.mvps.org/dmcritchie/excel/colors.htm

Tip: For changing the Font color see the example lines below the macros.

Sub Color_cells_In_Range_Or_Sheet()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim Rng As Range
    Dim I As Long

    'Fill in the search Value and color Index
    MySearch = Array("ron")
    myColor = Array("3")

    'You can also use more values in the Array
    'MySearch = Array("ron", "jelle", "judith")
    'myColor = Array("3", "6", "10")

    'Fill in the Search range, for the whole sheet use
    'you can use Sheets("Sheet1").Cells
    With Sheets("Sheet1").Range("B1:D100")

        'Change the fill color to "no fill" in all cells
        .Interior.ColorIndex = xlColorIndexNone

        For I = LBound(MySearch) To UBound(MySearch)

            'If you want to find a part of the rng.value then use xlPart
            'if you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to MySearch(I)
            Set Rng = .Find(What:=MySearch(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rng.Interior.ColorIndex = myColor(I)
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With
End Sub


Example for all worksheets in the workbook

Sub Color_cells_In_All_Sheets()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim Rng As Range
    Dim I As Long
    Dim sh As Worksheet

    'Fill in the search Value and color Index
    MySearch = Array("ron")
    myColor = Array("3")

    'You can also use more values in the Array
    'MySearch = Array("ron", "jelle", "judith")
    'myColor = Array("3", "6", "10")

    For Each sh In ActiveWorkbook.Worksheets

        'Fill in the Search range, for a range on each sheet
        'you can use sh.Range("B1:D100")
        With sh.Cells

            'Change the fill color to "no fill" in all cells
            .Interior.ColorIndex = xlColorIndexNone

            For I = LBound(MySearch) To UBound(MySearch)

                'If you want to find a part of the rng.value then use xlPart
                'if you use LookIn:=xlValues it will also work with a
                'formula cell that evaluates to MySearch(I)
                Set Rng = .Find(What:=MySearch(I), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)

                If Not Rng Is Nothing Then
                    FirstAddress = Rng.Address
                    Do
                        Rng.Interior.ColorIndex = myColor(I)
                        Set Rng = .FindNext(Rng)
                    Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                End If
            Next I
        End With
    Next sh
End Sub


Change the Font color instead of the Interior color

Replace:

‘Change the fill color to “no fill” in all cells
.Interior.ColorIndex = xlColorIndexNone

With

‘Change the font in the column to Automatic
.Font.ColorIndex = 0

And Replace:

Rng.Interior.ColorIndex = myColor(I)
With
Rng.Font.ColorIndex = myColor(I)

Copy cells to another sheet with Find

The example below will copy all cells with a E-Mail Address in the range
Sheets(“Sheet1”).Range(“A1:E100”) to a new worksheet in your workbook.
Note: I use xlPart in the code instead of xlWhole to find each cell with a @ character.

Sub Copy_To_Another_Sheet_1()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the search Value
    MyArr = Array("@")

    'You can also use more values in the Array
    'myArr = Array("@", "www")

    'Add new worksheet to your workbook to copy to
    'You can also use a existing sheet like this
    'Set NewSh = Sheets("Sheet2")
    Set NewSh = Worksheets.Add

    With Sheets("Sheet1").Range("A1:Z100")

        Rcount = 0

        For I = LBound(MyArr) To UBound(MyArr)

            'If you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "@"
            'Note : I use xlPart in this example and not xlWhole
            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Rng.Copy NewSh.Range("A" & Rcount)

                    ' Use this if you only want to copy the value
                    ' NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

More Information

If you only want to replace values in your worksheet then you can use Replace manual (Ctrl+h)
or use Replace in VBA. The code below replace ron for dave in the whole worksheet.
Change xlPart to xlWhole if you only want to replace cells with only ron.

    ActiveSheet.Cells.Replace What:="ron", Replacement:="dave", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, _
                              SearchFormat:=False, ReplaceFormat:=False

 

Tip: Try this add-in named FlexFind from Jan Karel Pieterse.
http://www.jkp-ads.com/OfficeMarketPlaceFF-EN.asp

Chip Pearson
http://www.cpearson.com/excel/RangeFind.htm

About berbagisolusi

Berbagi merupakan sebuah bentuk simbol keikhlasan untuk membantu dan menolong, sedangkan solusi adalah cara menyelesaikan masalah. Setiap manusia pasti mengalami masalah, tetapi kita tidak perlu mengalami masalah yang sama jika orang lain pernah mengalami dan kita tahu hal tersebut.

Discussion

No comments yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Enter your email address to follow this blog and receive notifications of new posts by email.

Join 9 other followers

June 2012
M T W T F S S
« May   Jul »
 123
45678910
11121314151617
18192021222324
252627282930  

Archives

Web Statistic

Blog Stats

  • 149,551 hits
%d bloggers like this: