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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
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)
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top