• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Procedures

I

inddon

Member
Hello There,

I have two set of code, both to be included in:
1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)

I would like to put each functionality code to its own procedures and call them from the event Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Could you please assists how this can be done?

Thanks & regards
Don
 
Hi Don ,

A Worksheet_SelectionChange event procedure is triggered when ever the position of the active cell is changed , by using either the cursor movement keys or the mouse.

You need to decide whether these two procedures that you mention should be executed for any cell in the worksheet , or only when the active cell is in a specific range of cells.

Narayan
 
NARAYANK991 said:
Hi Don ,

A Worksheet_SelectionChange event procedure is triggered when ever the position of the active cell is changed , by using either the cursor movement keys or the mouse.

You need to decide whether these two procedures that you mention should be executed for any cell in the worksheet , or only when the active cell is in a specific range of cells.

Narayan
Click to expand...


Hello Narayan,

These need to be executed from Worksheet_SelectionChange.

I have from 2 members from Chandoo.org sent me these two procedures of same name with different tasks:

1.Private Sub Worksheet_SelectionChange(ByVal Target As Range):
Performs Task A
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range):
Performs Task B

I want it to be something like this:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Call Task A
  Call Task B
end sub


Is that possible?

Regards
Don
 
Hi Don ,

What you have posted is possible , as long as you want that both these procedures ( Task A and Task B ) should always be executed together.

If you want that Task A should be executed only for certain conditions , while Task B should be executed for some other conditions , then you need to call these tasks only if their conditions are satisfied.

Narayan
 
NARAYANK991 said:
Hi Don ,

What you have posted is possible , as long as you want that both these procedures ( Task A and Task B ) should always be executed together.

If you want that Task A should be executed only for certain conditions , while Task B should be executed for some other conditions , then you need to call these tasks only if their conditions are satisfied.

Narayan
Click to expand...


Hello Narayan,

Thank you for your reply.

What parameters do I need to send to these procedures?

They are the same as Worksheet_SelectionChange

regards
Don
 
Hi Don ,

For detailed analysis , I think you should post the code for these 2 tasks , so that it can be seen whether these tasks will interact / interfere with each other.

Narayan
 
NARAYANK991 said:
Hi Don ,

For detailed analysis , I think you should post the code for these 2 tasks , so that it can be seen whether these tasks will interact / interfere with each other.

Narayan
Click to expand...

Hello Narayan,

Below is the code for the same event:

Look forward to hearing from you

regards
Don

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)


If Target.Count > 1 Then Exit Sub
  Target.Calculate

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  'Cells.RowHeight = 15
  If Not Intersect(Target, Range("WRMWire")) Is Nothing Then
  Range(Range("z1").Value).RowHeight = Range("z2").Value
  Range("Z2") = Target.RowHeight
  Range("Z1") = Target.Address
  Target.RowHeight = 25
  'Make current row font size 11
  'Rows(1).Font.Size = 10.5
  End If
  
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tb As ListObject, pth As String, crt1 As String, crt2 As String
Dim cn As ADODB.Connection, strQuery As String, rst As ADODB.Recordset, strCon As String, Header As Boolean
Set tb = Me.ListObjects("WRMWire")



If Intersect(Target, tb.ListColumns(44).DataBodyRange) Is Nothing Or 1 < Target.Cells.Count Then Exit Sub
Set cn = New ADODB.Connection

pth = ActiveWorkbook.Path
crt1 = Cells(ActiveCell.Row, 44).Value
crt2 = Cells(ActiveCell.Row, 44).Value


If IsEmpty(crt1) Or IsEmpty(crt2) Then Exit Sub

  

  strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  "Data Source=" & pth & "\File Master.xls;" & _
  "Extended Properties=""Excel 12.0;HDR=Yes"";"

  cn.Open strCon

  'strQuery = "SELECT * FROM [Master$A:M] WHERE [Party Name]='" & crt1 & "' AND [VAT number]=" & crt2 & ";"
  strQuery = "SELECT * FROM [Sheet1$A:R] WHERE [Party Name]='" & crt1 & "' AND [Party Name]=" & crt1 & ";"
  Set rst = New ADODB.Recordset
  rst.Open strQuery, cn, adOpenStatic, adLockReadOnly, adCmdText
  

  Dim i As Integer
  rst.MoveFirst
  i = 0

  
  With ActiveSheet.ComboBox1
  .Clear
  Do
  .AddItem
  .List(i, 0) = rst![Customer Name]
  .List(i, 1) = rst![VAT number]
  .List(i, 2) = rst![Country]
  .List(i, 3) = rst![City]
  .List(i, 4) = rst![Amount 1]
  .List(i, 5) = rst![Amount 2]
  .List(i, 6) = rst![Amount 2]
  i = i + 1
  rst.MoveNext
  Loop Until rst.EOF
  .Activate
  .DropDown
  End With

  rst.Close
  Set rst = Nothing
  Set cn = Nothing


End Sub
 
Hi Don ,

If the workbook were uploaded it would be possible to test the changes ; now , you will have to confirm whether this works or not.
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
            If Target.Count > 1 Then Exit Sub
            Target.Calculate

            Application.ScreenUpdating = False
            Application.EnableEvents = False
'           Cells.RowHeight = 15
             If Not Intersect(Target, Range("WRMWire")) Is Nothing Then
              Range(Range("z1").Value).RowHeight = Range("z2").Value
              Range("Z2") = Target.RowHeight
              Range("Z1") = Target.Address
              Target.RowHeight = 25
'             Make current row font size 11
'             Rows(1).Font.Size = 10.5
             End If

            Dim tb As ListObject, pth As String, crt1 As String, crt2 As String
            Dim cn As ADODB.Connection, strQuery As String, rst As ADODB.Recordset, strCon As String, Header As Boolean
            Set tb = Me.ListObjects("WRMWire")

            If Intersect(Target, tb.ListColumns(44).DataBodyRange) Is Nothing Or 1 < Target.Cells.Count Then Exit Sub
            Set cn = New ADODB.Connection

            pth = ActiveWorkbook.Path
            crt1 = Cells(ActiveCell.Row, 44).Value
            crt2 = Cells(ActiveCell.Row, 44).Value

            If IsEmpty(crt1) Or IsEmpty(crt2) Then Exit Sub

            strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & pth & "\File Master.xls;" & _
                    "Extended Properties=""Excel 12.0;HDR=Yes"";"

            cn.Open strCon

'           strQuery = "SELECT * FROM [Master$A:M] WHERE [Party Name]='" & crt1 & "' AND [VAT number]=" & crt2 & ";"
             strQuery = "SELECT * FROM [Sheet1$A:R] WHERE [Party Name]='" & crt1 & "' AND [Party Name]=" & crt1 & ";"
            Set rst = New ADODB.Recordset
            rst.Open strQuery, cn, adOpenStatic, adLockReadOnly, adCmdText

            Dim i As Integer
            rst.MoveFirst
            i = 0

            With ActiveSheet.ComboBox1
                .Clear
                Do
                    .AddItem
                    .List(i, 0) = rst![Customer Name]
                    .List(i, 1) = rst![VAT number]
                    .List(i, 2) = rst![Country]
                    .List(i, 3) = rst![City]
                    .List(i, 4) = rst![Amount 1]
                    .List(i, 5) = rst![Amount 2]
                    .List(i, 6) = rst![Amount 2]
                    i = i + 1
                    rst.MoveNext
                Loop Until rst.EOF
                .Activate
                .DropDown
            End With

            rst.Close
            Set rst = Nothing
            Set cn = Nothing
            Application.EnableEvents = True
End Sub
Narayan
 
You must log in or register to reply here.
Back
Top