davesexcel.com

Excel information

Most Popular Excel Questions

view:  full / summary

Message Box to display a cell value when a criteria is met.

Posted by davesexcel on March 28, 2012 at 5:00 AM Comments comments (0)

When A1=>10, I want a message box to pop up telling me the value of A1 and then a yes or no button.

A1 is the Sun of B1:B3.

--------------------------------------------------------------------------------------

You can get the msgbox code straight from excels VBA help file.

The worksheet_Calculate event can be used in this situation.

Right click on the Sheet tab and select View Code,

Copy and paste the code there.

The code will only activate if A1 is 10 or greater.

Private Sub Worksheet_Calculate()

    If Range("A1") < 10 Then Exit Sub

    Dim Msg, Style, Title, Help, Ctxt, Response, MyString

    Msg = "A1 = " & Range("A1") & " , Do you want to continue ?"   ' Define message.

    Style = vbYesNo + vbInformation + vbDefaultButton2    ' Define buttons.

    Title = "Hello"    ' Define title.

    Help = "DEMO.HLP"    ' Define Help file.

    Ctxt = 1000    ' Define topic

    ' context.

    ' Display message.

    Response = MsgBox(Msg, Style, Title, Help, Ctxt)

    If Response = vbYes Then    ' User chose Yes.

        MsgBox "You selected Yes"    ' Perform some action.

    Else    ' User chose No.

        MsgBox "You selected No"    ' Perform some action.

    End If

End Sub

 Another Message Box example can be found here.

http://www.davesexcel.com/vbacodes.htm#858296103

 


"How do I find data in a column, then copy and paste it to a new location?"

Posted by davesexcel on December 1, 2010 at 6:05 AM Comments comments (1)

This is one of the most popular excel quetions.


This example uses 2 ways to find data. A loop and a filter.




The first code loops through Column A and identifies the selection made from the ComboBox. When it finds an equal match it will copy and paste the item from Column A and B and paste it into the first empty row after the last used row in Column D.


'********************************************


Sub CopyAndPasteLoop()

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

'Make a selection from the ComboBox

'Click the button of your choie of macro

 

    Dim R As Range, c As Range, Rng As Range

    Dim LstRw As Long, LstRws2 As Long

    Dim Str As String

 

    Str = Worksheets("Sheet1").ComboBox1

 

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row

 

 

    Set R = Range(Cells(1, 1), Cells(LstRw, 1))

 

    ClearData

 

    For Each c In R.Cells

 

        LstRws2 = Cells(Rows.Count, "D").End(xlUp).Row + 1

        Set Rng = Cells(LstRws2, 4)

 

        If c = Str Then c.Range("A1:B1").Copy Destination:=Rng

 

    Next c

 

End Sub


'***************************************************

This next code the same thing, but pastes the results to Sheet2


'***********************************************************


Sub CopyAndPasteLoopToSheet2()

 

    Dim R As Range, c As Range, Rng As Range

    Dim LstRw As Long, LstRws2 As Long

    Dim Str As String, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

 

    Str = Worksheets("Sheet1").ComboBox1

 

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row

 

 

    Set R = Range(Cells(1, 1), Cells(LstRw, 1))

 

    ClearData

    ClearDataSheet2

 

    For Each c In R.Cells

 

        LstRws2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

        Set Rng = ws2.Cells(LstRws2, 1)

 

        If c = Str Then c.Range("A1:B1").Copy Destination:=Rng

 

    Next c

 

    MsgBox "Finshed Copying to Sheet2"

 

End Sub

 

 


'******************************************************


The next code will use AutoFilter to filter out the item selected from the ComboBox and paste it to D2.


'*******************************************************

Sub FilterAndPaste()

 

    Dim Frng As Range, D2 As Range

    Dim Str As String

 

    Set D2 = Range("D2")

    Str = Worksheets("Sheet1").ComboBox1

 

    ClearData

 

    Range("A1").AutoFilter Field:=1, Criteria1:=Str

 

    With ActiveSheet.AutoFilter.Range

 

        Set Frng = .Offset(1, 0).Resize(.Rows.Count - 1, 2) _

                   .SpecialCells(xlCellTypeVisible)

 

    End With

 

    Frng.Copy Destination:=d2

 

    Range("A1").AutoFilter

 

End Sub

 

 


'******************************************************************


This uses the filter method and sends the filtered items to Sheet2

'*******************************************************************


Sub FilterAndPasteToSheet2()

 

    Dim Frng As Range, A2 As Range

    Dim Str As String, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

    Set A2 = ws2.Range("A2")

    Str = Worksheets("Sheet1").ComboBox1

 

    ClearData

    ClearDataSheet2

 

    Range("A1").AutoFilter Field:=1, Criteria1:=Str

 

    With ActiveSheet.AutoFilter.Range

 

        Set Frng = .Offset(1, 0).Resize(.Rows.Count - 1, 2) _

                   .SpecialCells(xlCellTypeVisible)

 

    End With

 

    Frng.Copy Destination:=A2

 

    Range("A1").AutoFilter

 

    MsgBox "Finshed Copying to Sheet2"

 

 

End Sub

 

 

 

"*****************************************************


You will need this code or you will get errors, all it does is clear the range before pasting new results.

'**********************************************

Sub ClearData()

 

    Dim Rws As Long, Rng As Range

 

 

    Rws = Cells(Rows.Count, "D").End(xlUp).Row

 

    Set Rng = Range(Cells(2, 4), Cells(Rws + 1, 5))

 

    Rng.Clear

 

 

End Sub

Sub ClearDataSheet2()

 

    Dim Rws As Long, Rng As Range, ws2 As Worksheet

 

    Set ws2 = Worksheets("Sheet2")

 

 

 

    Rws = ws2.Cells(Rows.Count, "A").End(xlUp).Row

 

    Set Rng = ws2.Range(ws2.Cells(2, 1), ws2.Cells(Rws, 2))

 

    Rng.Clear

 

 

End Sub

 

 

'******************************************************

 

 

Download the Sample Workbook




 The example also shows how to populate a combobox with unique items. Right click on the sheet tab, select view code.

 








Rss_feed