VBA: Dropdown_Click() is not working in Workbook

[ssingh75]

Hi All,

I am using below code which is working in Dropdown_Change() but it is not working in Dropdown_Click()

Pls suggest. I want to use the same code if someone click on my dropdown but there is no change in selection criteria..

Sub DropDown3232_Click()
    Dim rngCell As Range
    Dim strGlobal, strTemp As String
    Dim strAdd, strAdd1, strAdd2 As String
    Dim wkbktemp As Workbook
    Dim strEstinSpend As String
    Dim rngFull, Rng As Range
    Dim ws, shtQuery As Worksheet
    Dim lRows, lRows1 As Long
    Dim lCols, lCols1 As Long
    Dim iStart, iEnd, iTotal As Single
    Dim sSQL As String
    Dim cell As Range
    Dim rs As ADODB.Recordset
    Dim i, j, k As Integer
    Dim srt As Sort
    Dim strPic, strPic1, strProd, strProd1, strRelDate, strRelDate1 As String
    Dim strProj1, strProj2 As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'iStart = Now()
    iStart = Timer
    
    Set ws = shtWorldMarketing
    Set shtQue = shtQuery
    strGlobal = ActiveWorkbook.Name
    ws.Activate
        
    With ws.Shapes("Drop Down 3232").ControlFormat
        strEstinSpend = .List(.Value)
    End With
    
    lRows = ws.UsedRange.Rows.Count
    lCols = ws.UsedRange.Columns.Count
    
    For i = 1 To lCols
        Range("B7").Select
        ActiveCell.Offset(0, i).Select
        If ActiveCell.Text = "" Or ActiveCell.Value = "" Then
            Exit For
        End If
        If ActiveCell.Text <> "" Or ActiveCell.Value <> "" Then
            ActiveCell.ClearContents
            ActiveCell.Offset(1).ClearContents
            ActiveCell.Offset(2).ClearContents
        End If
    Next
    
    Range("A1").Select
    For i = 1 To lRows
        ActiveCell.Offset(1, 0).Select
        If Trim(ActiveCell.Text) = "Manual entry" Then
            strAdd = ActiveCell.Offset(1, 0).Address
            Exit For
        End If
    Next
    
    cleanTopsheet ws.Range(strAdd)
    
    If (Range("Query").Rows.Count = 1) Then
        Call MsgBox("The Topsheet cannot be built because the Query has returned no data." _
                    & vbCrLf & "" _
                    & vbCrLf & "Please refresh the query and try again." _
                    , vbInformation, "No Data in Query")
                    
        Exit Sub
    End If
    
    '*****Populate All Sales History Query Data in TopSheet"
    Sheets("Query").Activate
    lCols1 = ActiveSheet.UsedRange.Columns.Count
    lRows1 = ActiveSheet.UsedRange.Rows.Count
    
    For i = 1 To lCols1
        Range("A6").Select
        ActiveCell.Offset(0, i).Select
            If ActiveCell.Text <> "" And ActiveCell.Offset(0, -1).Text <> "" And ActiveCell.Text = ActiveCell.Offset(0, -1).Text And ActiveCell.Text <> "Overall Result" Then
                strPic = ActiveCell.Offset(0, -1).Text
                strProd = ActiveCell.Offset(1, -1).Text
                strRelDate = ActiveCell.Offset(2, -1).Text
                ws.Activate
                For j = 1 To lCols
                    Range("B7").Select
                    ActiveCell.Offset(0, j).Select
                    If ActiveCell.Text = "" Then
                        ActiveCell.Value = strPic
                        ActiveCell.Offset(1).Value = strProd
                        ActiveCell.Offset(2).Value = strRelDate
                        Exit For
                    End If
                Next
            ElseIf ActiveCell.Text = "Overall Result" Then
                strPic = ActiveCell.Text
                strProd = ActiveCell.Offset(1, 0).Text
                strRelDate = ActiveCell.Offset(2, 0).Text
                ws.Activate
                For j = 1 To lCols
                    Range("B7").Select
                    ActiveCell.Offset(0, j).Select
                    If ActiveCell.Text = "" Then
                        ActiveCell.Value = strPic
                        ActiveCell.Offset(1).Value = strProd
                        ActiveCell.Offset(2).Value = strRelDate
                        Exit For
                    End If
                Next
            End If
            Sheets("Query").Activate
    Next
    
    ws.Activate
    lRows = Range("Query").Rows.Count - 1
    lCols = Range("Query").Columns.Count
    
    CreateWorkbookConnection
    
    Set ws = shtWorldMarketing
    Workbooks.Add
    Set wkbktemp = ActiveWorkbook
    strFileLocation = GetTempDir & "TempQuery " & Year(Now()) & Month(Now()) & Hour(Now()) _
    & Minute(Now()) & Second(Now()) & ".xlsx"
    
    With wkbktemp
            sSQL = "SELECT Q.* FROM [Query] Q"
            Set rs = New ADODB.Recordset
            rs.Open sSQL, objConnection, adOpenStatic
            ActiveSheet.Range("A1").CopyFromRecordset rs
            Set rs = Nothing
            Destructor
            
            lRows = ActiveSheet.UsedRange.Rows.Count
            lCols = ActiveSheet.UsedRange.Columns.Count
            Range("B4").Select
            For i = 1 To lCols
                ActiveCell.Offset(0, 1).Select
                If ActiveCell.Text <> "" And ActiveCell.Offset(-1, 0).Text = "#" Then
                    strAdd = ActiveCell.Text
                    ActiveCell.Value = strAdd & "_" & ActiveCell.Offset(-2, 0).Text
                ElseIf ActiveCell.Text <> "" And ActiveCell.Offset(-1, 0).Text = "" Then
                    strAdd = ActiveCell.Text
                    ActiveCell.Value = strAdd & "_" & "Overall Result"
                End If
            Next
            Rows("1:3").Select
            Selection.Delete Shift:=xlUp
            Application.DisplayAlerts = False
            .SaveAs strFileLocation
    '        .Close
            Application.DisplayAlerts = True
    End With
    
     If strEstinSpend = "Estimated Final Cost" Then
    
        strTemp = "TempQuery" & " " & Trim(Replace(Split(strFileLocation, "TempQuery")(1), ",", ""))
        lCols = ActiveSheet.UsedRange.Columns.Count
        Range("C1").Select
            For i = 1 To lCols
                ActiveCell.Offset(0, 1).Select
                strAdd1 = Trim(Replace(Split(ActiveCell.Address, "$")(1), ",", ""))
                If ActiveCell.Text <> "" Then
                    strAdd2 = InStr(ActiveCell.Text, "Global Marketing Amounts")
                    If strAdd2 = 1 Then
                        GoTo Nxt
                    ElseIf strAdd2 = 0 Then
                        ActiveCell.EntireColumn.Delete Shift:=xlToRight
                    End If
                ElseIf ActiveCell.Text = "" Then
                    Exit For
Nxt:
                End If
            Next
            
            '***Delete Rows if no data in Cell*****
            Range("A1").Select
            For i = 1 To lCols
                ActiveCell.Offset(0, 1).Select
                strAdd1 = Trim(Replace(Split(ActiveCell.Address, "$")(1), ",", ""))
                strAdd2 = InStr(ActiveCell.Text, "Overall Result")
                If strAdd2 > 1 Then
                    lRows = ActiveSheet.UsedRange.Rows.Count
                        For j = 1 To lRows
                            Range(strAdd1 & 1).Select
                            ActiveCell.Offset(j, 0).Select
                            If ActiveCell.Text = "" And Range("A" & j + 1).Text <> "" Then
                                ActiveCell.EntireRow.Delete Shift:=xlUp
                                j = j - 1
                            End If
                        Next
                End If
            Next
            
            Call Update_Data
            Range("A1").Select
            lRows = ActiveSheet.UsedRange.Rows.Count
            Range("A2:" & strAdd1 & lRows).Select
            Selection.Copy
            Windows.Item(strGlobal).Activate
            ws.Range("A12").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Selection.PasteSpecial Paste:=xlPasteFormats
            Windows.Item(strTemp).Close True
     End If
    
    '******Spent/Commited*****
    
    If strEstinSpend = "Spent/Commited" Then
        strTemp = "TempQuery" & " " & Trim(Replace(Split(strFileLocation, "TempQuery")(1), ",", ""))
        lCols = ActiveSheet.UsedRange.Columns.Count
        Range("C1").Select
            For i = 1 To lCols
                ActiveCell.Offset(0, 1).Select
                strAdd1 = Trim(Replace(Split(ActiveCell.Address, "$")(1), ",", ""))
                If ActiveCell.Text <> "" Then
                    strAdd2 = InStr(ActiveCell.Text, "SAP Spent & Committed")
                    If strAdd2 = 1 Then
                        GoTo Nxt1
                    ElseIf strAdd2 = 0 Then
                        ActiveCell.EntireColumn.Delete Shift:=xlToRight
                    End If
                ElseIf ActiveCell.Text = "" Then
                    Exit For
Nxt1:
                End If
            Next
            
            '***Delete Rows if no data in Cell*****
            Range("A1").Select
            For i = 1 To lCols
                ActiveCell.Offset(0, 1).Select
                strAdd1 = Trim(Replace(Split(ActiveCell.Address, "$")(1), ",", ""))
                strAdd2 = InStr(ActiveCell.Text, "Overall Result")
                If strAdd2 > 1 Then
                    lRows = ActiveSheet.UsedRange.Rows.Count
                        For j = 1 To lRows
                            Range(strAdd1 & 1).Select
                            ActiveCell.Offset(j, 0).Select
                            If ActiveCell.Text = "" And Range("A" & j + 1).Text <> "" Then
                                ActiveCell.EntireRow.Delete Shift:=xlUp
                                j = j - 1
                            End If
                        Next
                End If
            Next
            
            Call Update_Data
            Range("A1").Select
            lRows = ActiveSheet.UsedRange.Rows.Count
            Range("A2:" & strAdd1 & lRows).Select
            Selection.Copy
            Windows.Item(strGlobal).Activate
            ws.Range("A12").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Selection.PasteSpecial Paste:=xlPasteFormats
            
            Windows.Item(strTemp).Close False
    End If
    Range("A1").Select
    Application.DisplayAlerts = True
    
    MsgBox "Report Updated in " & Timer - iStart & " Seconds", vbOKOnly
End Sub

 

[AlphaFrog]

Your control is a Form-type drop down. It doesn't have a _Click event procedure unfortunately. Have you considered using an ActiveX-type combobox instead? It does have a _Click event procedure.

Or if your only goal is to just trigger if the user re-selects the previously selected item again, one kludge is to clear the selected item at the end of your code.

   [COLOR=green]'Clear selected item[/COLOR]
   ActiveSheet.DropDowns("Drop Down 3232").ListIndex = 0

On another note:
When you declare multiple variables on one line like this...
Dim strGlobal, strTemp As String
Only the last variable is type string. The previous variables are the defalt type variant. Each variable has to be typed specifically.
Dim strGlobal as String, strTemp As String

 

[ssingh75]

Thanks Expert..Will let u know if i needed anything on the same again............

 

[ssingh75]

Thanks Expert..Will let u know if i needed anything on the same again............

Hi ,

I m calling my dropdown from different module and getting the below error.
'excel vba unable to get the list property of the dropdown class'
With ws.Shapes("Drop Down 3232").ControlFormat
strEstinSpend = .List(.Value)
End With

 

[AlphaFrog]

Remove the .ControlFormat

.List and .Value are properties of just the Drop Down

 

[ssingh75]

Remove the .ControlFormat

.List and .Value are properties of just the Drop Down

Thanks Expert...
But im getting object doesnt support this property or method...
With ws.Shapes("Drop Down 3232")
strEstinSpend = .List(.Value)
End With

Actually i want to reset my sheet as blank if my dropdown is blank...I m getting data fromsome connection string so when my Query sheet got refreshed then my dropdown default selection will be blank. then automatically my old data will get remove from main sheet..

 

[RoryA]

Is the Drop down empty when you try to access its List property?

 

[ssingh75]

Is the Drop down empty when you try to access its List property?

Yup Rory...Its Empty

 

[RoryA]

That's the problem then.

The List returns Null so you can't access an element of it. You need to test for that first:

With ws.Dropdowns("Drop Down 3232")
if not isnull(.List) then strEstinSpend = .List(.Value)
End With

for example.

 

[RoryA]

That's the problem then.

The List returns Null so you can't access an element of it. You need to test for that first:

With ws.Dropdowns("Drop Down 3232")
if not isnull(.List) then strEstinSpend = .List(.Value)
End With

for example.