Active Cell Indicator Disappeared

BiGV

New Member
Joined
Mar 26, 2013
Messages
4
Hi There,

I am running a macro that is causing my active cell indicator to disappear. In term of clicking around, I can still select cells, highlight cells and type formula's into cells. However, the black border that surrounds an active cell doesn't work. My file is completely macro driven and used by multiple users. I know that restarting Excel fixes the issue, but I need to be able to not have this issue in the first place. Does anyone know what property could be causing this issue?

Also, once the Active Cell Indicator disappears, Auto Filters on another macro does not work.

Any help would be greatly appreciated.

Excel 2010 32 Bit on Windows 7
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

BiGV

New Member
Joined
Mar 26, 2013
Messages
4
Thanks for your reply, unfortunately, the Formula Bar tick has no impact. With or without the formula bar you should still be able to see the Active Cell indicator (black box)
 

nuked

Well-known Member
Joined
Mar 20, 2013
Messages
883
Is the workbook 'shared'?
 

BiGV

New Member
Joined
Mar 26, 2013
Messages
4
Welcome to MrExcel.

Can you post the offending macro please?
Here's the code, its long and probably not very well written - I can't see what is causing the issue, sometimes the Active Cell Indicator works fine and other times it fails.

Code:
Sub My_Macro()Dim rng1
Dim rng2


Set rng1 = Worksheets("Score Card").Range("H10:M31")
Set rng2 = Worksheets("Score Card").Range("H35:M35")


On Error Resume Next
Application.ScreenUpdating = False
If Intersect(ActiveCell, Union(rng1, rng2)) Is Nothing Then
MsgBox "Drill Down in not available for this field, please select again.", vbCritical + vbOKOnly
Exit Sub
End If


'Team
On Error Resume Next
Worksheets("Query").Range("C2").Value = Worksheets("Score Card").Range("D2").Value


If Range("H3").Value = True Then
Worksheets("Query").Range("D2").Value = Worksheets("Score Card").Range("D4").Value
Else
Worksheets("Query").Range("D2").Value = ""
End If


'Month
On Error Resume Next
Worksheets("Query").Range("C3").Value = Worksheets("Score Card").Range("J2").Value


'Stage
On Error Resume Next
Worksheets("Query").Range("C4").Value = Cells(9, ActiveCell.Column).Value


'Product
On Error Resume Next
Worksheets("Query").Range("C5").Value = Cells(ActiveCell.Row, 6)




Call Macro2
Worksheets("Drill Down").Activate
Call addhyperlink
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Sub Macro2()
Dim Fieldcheck
Dim ldate As String
Dim i
Dim lastRow


On Error Resume Next
Application.Calculation = xlCalculationManual
Worksheets("Drill Down").Activate
ActiveSheet.ShowAllData
'If Worksheets("Query").Range("D2").Value = "" Then
'ActiveSheet.ShowAllData
'End If
lastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range("A2:AC" & lastRow).ClearContents




i = 3
For i = 3 To 6


On Error Resume Next
If Worksheets("Query").Cells(11, i).Value = "" Then
GoTo NextI
End If
'Team/Region
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B10").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)


Worksheets("Pipeline").Activate
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False


On Error Resume Next
If Worksheets("Query").Range("C10").Value = "EMEA TOTAL" Then
GoTo Product
Else
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
    Application.WorksheetFunction.VLookup(Worksheets("Query").Range("C10").Value, Worksheets("Team Table").Range("G1:H27"), 2, 0), Operator:=xlFilterValues
Debug.Print Application.WorksheetFunction.VLookup(Worksheets("Query").Range("C10").Value, Worksheets("Team Table").Range("G1:H27"), 2, 0)
End If
Product:
Worksheets("Query").Activate


'Product Group
'vlookup for column number


On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B13").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
    Worksheets("Query").Range("C13").Value, Operator:=xlFilterValues
Worksheets("Query").Activate
    
'Close Month
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B11").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)


If Worksheets("Query").Range("C4").Value = "120+ DAYS" Then


ldate = DateSerial(Year(Worksheets("Query").Cells(11, i).Value), Day(Worksheets("Query").Cells(11, i).Value), Month(Worksheets("Query").Cells(11, i).Value))
Debug.Print ldate
Debug.Print Worksheets("Query").Cells(11, i).Value
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
    ">=" & ldate, Operator:=xlFilterValues


Else
ldate = DateSerial(Year(Worksheets("Query").Cells(11, i).Value), Month(Worksheets("Query").Cells(11, i).Value), Day(Worksheets("Query").Cells(11, i).Value))
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
    ldate, Operator:=xlFilterValues
End If
Worksheets("Query").Activate
    
'Stage
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B12").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
    Worksheets("Query").Cells(12, i).Value, Operator:=xlFilterValues
Worksheets("Query").Activate






'Copy Data


Call MergeData




NextI:


Next


If Worksheets("Query").Range("D2").Value = "" Then
Else
Worksheets("Drill Down").Activate
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=6, Criteria1:= _
    Worksheets("Query").Range("D2").Value, Operator:=xlFilterValues
End If


Worksheets("Pipeline").AutoFilterMode = False


End Sub




Sub MergeData()


Dim lastrowCIQ As Long
Dim lastrowpipe As Long
Dim ciq As Worksheet
Dim pipe As Worksheet


Set ciq = Worksheets("Drill Down")
Set pipe = Worksheets("Pipeline")


On Error Resume Next
lastrowCIQ = ciq.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastrowpipe = pipe.Cells(Rows.Count, 1).End(xlUp).Row
If lastrowpipe = 1 Then
Exit Sub
End If


Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ciq.Activate


    
'Team
pipe.Range("B2:B" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues




'Opportunity Name
pipe.Range("E2:E" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues




'Company/Account Name
pipe.Range("F2:F" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues


'ACV
pipe.Range("H2:H" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Product Family
pipe.Range("L2:L" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Owner
pipe.Range("O2:O" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Close Date
pipe.Range("R2:R" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Stage
pipe.Range("T2:T" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Confidence
pipe.Range("Z2:Z" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 9).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Vish Cat
pipe.Range("AA2:AA" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Vish Sales Manager
pipe.Range("AB2:AB" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 11).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Quarter
pipe.Range("AC2:AC" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Opp ID
pipe.Range("A2:A" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 13).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Created Date
pipe.Range("C2:C" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Lead Source
pipe.Range("D2:D" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 15).Select
Selection.PasteSpecial Paste:=xlPasteValues


'ACV Currency
pipe.Range("I2:I" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 16).Select
Selection.PasteSpecial Paste:=xlPasteValues


'ACV
pipe.Range("J2:J" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 17).Select
Selection.PasteSpecial Paste:=xlPasteValues


'ACV Currency USD
pipe.Range("G2:G" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 18).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Product Name
pipe.Range("K2:K" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 19).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Product Platform
pipe.Range("M2:M" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 20).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Primary Country
pipe.Range("N2:N" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 21).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Users
pipe.Range("P2:P" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 22).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Entitlements
pipe.Range("Q2:Q" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 23).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Close Month
pipe.Range("S2:S" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 24).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Modified Date
pipe.Range("U2:U" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 25).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Stage Duration
pipe.Range("V2:V" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 26).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Segment
pipe.Range("W2:W" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 27).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Group
pipe.Range("X2:X" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 28).Select
Selection.PasteSpecial Paste:=xlPasteValues


'Specialty
pipe.Range("Y2:Y" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 29).Select
Selection.PasteSpecial Paste:=xlPasteValues


Application.EnableEvents = True


End Sub
 

BiGV

New Member
Joined
Mar 26, 2013
Messages
4
What's addhyperlink?
Another macro that hyperlinks my cells to a website

Code:
Sub addhyperlink()

Dim lrows As Long


Application.Calculation = xlCalculationManual




For lrows = 3 To Range("A2").End(xlDown).Row
    With Cells(lrows, 4)
        .Hyperlinks.Add Anchor:=Cells(lrows, 4), _
        Address:="http://na2.salesforce.com/" & Cells(lrows, 1).Value & "", _
        TextToDisplay:="" & Cells(lrows, 4).Value & ""
    End With
Next lrows


End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,099,097
Messages
5,466,636
Members
406,493
Latest member
Hazem Hassan

This Week's Hot Topics

Top