VBA and Highlight function has stopped the Undo Funciton

[xDroptek]

Hi i have a spreadsheet which was working correctly until a few days ago, theres a VBA code which gathers data from another spreadsheet into a pivot table then then manipulates the data in correct form and spits out the data on the primary sheet (consolidated). i also have a Highlight function which highlight the row ive currently selected. as of a few days ago i can no longer use the Undo/Redo at all unless i disable the Highlight function.
The Code is to automate a whole process which usually takes a few days to complete now only takes me 5 min, theres a button at the top called "sheet setup" which only works if another sheet is open and names "1" but the button will not work for anyone else.

Can anyone fix the code or let me know the code to enable the VBA, Highlight, and allow me to use the Undo/Redo (CTRL+Z/CTRL+Y).

Thanks in Advance

Hi all I've created an automated worksheet to basically do my job for me, ever since the VBA has been put in I can no longer Undo/Redo any changes I make, is there a way around this?

Thanks in advance

[Aussiebear]

xDroptek, firstly welcome to VBAX forum. Please stay with one thread. If you find that you are not receiving any responses, you can by all means bump your thread to bring it back to the top of the list so others can try to assist.

Now which section of code when added caused the issue and what does it not allow to be undone? On a side note, that an awful set of colours you are using to define your workbook. I'd hate to be looking it for more than a minute or two.

[xDroptek]

Hi AussieBear,
Thankyou for letting me know i wasnt aware you could bump Threads. Regarding the code itself, The whole code was rewritten to allow for the automation (module 1-6 were added,the main worksheet code which allows the "highlight function" is the only previous code, but if i ' out the main Worksheet code then i can utilise the undo/redo function). Once a change is made to a cell/row/column i cant undo ANY changes, the undo/redo arrows are just greyed out.

I can live without the highlight function but im working with multiple monitors & Programs and lose where i am constantly.
Each template is changed depending on the user so the colours are always changing especially for colourblind individuals, this is just a stock template we made when i joined.

Previously me and my colleague had writting a macro to achieve partial automation but it was sluggish & slow, about a 10 step process in the end but i retired that and implimented the new code.

***i had to reply twice as i lost connection sorry if there is more than 1 reply***

[Aussiebear]

So this code from Module 1 is the culprit you think?

Sub Main()
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim x As Long
Dim strThisFileName As String
Dim FileOpenCheck As Boolean
FileOpenCheck = IsWorkBookOpen("1.xlsx")
If FileOpenCheck Then
Else
   MsgBox "1.xlsx is not open", vbInformation
   Exit Sub
End If
strThisFileName = ActiveWorkbook.Name
Call Import(strThisFileName)
Call DeleteBlanks
ActiveSheet.Range("B10").Select
' Finding LastRow based on column B
For i = 10 To 10000
    If ActiveCell.Value = "" Then
        Selection.EntireRow.Delete
        ActiveCell.Offset(-1).Select
        LastRow = i - 1
        Exit For
    End If
    ActiveCell.Offset(1).Select
    If i = 10000 Then
        Exit For
    End If
Next
'Select A10
ActiveSheet.Range("A10").Select
For i = 1 To 10000
    If ActiveCell.Value = "" Then
        Exit For
    End If
    x = ActiveCell.Row
    For j = 0 To 9999
        ActiveCell.Offset(1).Select
        If ActiveCell.Value <> "" Or ActiveCell.Row > LastRow Then
            LastRow2 = ActiveCell.Row - 1
            ActiveSheet.Range(Cells(x, 2), Cells(LastRow2, 7)).Select
            ' Sort bits
            Range(Cells(x, 2), Cells(LastRow2, 7)).Sort Key1:=Range(Cells(x, 2), Cells(LastRow2, 2)), Order1:=xlAscending, Header:=xlNo
            Call zFormatCells2
            ActiveSheet.Range(Cells(x, 1), Cells(LastRow2, 1)).Select
            Call zFormatCells
            ActiveCell.Offset(1).Select
            Exit For
        End If
    Next
    If x > LastRow Then
        Exit For
    End If
Next
Call GreyItOut
Workbooks(strThisFileName).Activate
Worksheets("EstimateOne").Visible = False
Worksheets("Pivot").Visible = False
Call MakeEmailHyperlink
Range("A10:A10000").Font.Size = 20
Range("A10:A10000").Font.Bold = True
Call AddFormula
ActiveSheet.Range("A10").Select
ActiveWindow.WindowState = xlMaximized
ActiveSheet.Shapes("Button 1").Delete
ActiveWorkbook.Save
Workbooks("1.xlsx").Close SaveChanges:=False
End Sub

Sub zFormatCells()
With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        'Selection.Merge
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
End Sub

Sub zFormatCells2()
With Selection
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
End With
End Sub


Function IsWorkBookOpen(Name As String) As Boolean
    Dim xlWb As Workbook
    On Error Resume Next
    Set xlWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xlWb Is Nothing)
End Function

[xDroptek]

Module 1 is the main Module which is basically just the compiled Code from all modules, module 1 is the whole code into one, it just "calls" the other modules by name. so yes i believe it has somthing to do with that. but if i exclude the Highlight code in the main worksheet everything works

[Jan Karel Pieterse]

Change the code in the worksheet_selectionchange event to this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Calculate
End Sub

Change the HighlightRow range name's formula to this:

=ROW(ACTIVE.CELL())+0*NOW()

[xDroptek]

Hi Jan,

I cant seem to put the HighlightRow Conditional Format in? i just get an error "this Function isnt valid"

[Jan Karel Pieterse]

Worked fine for me, see attached.

[xDroptek]

Hey Jan,

ive downloaded the sheet and had a look i see what youve done but its not highlighting the row ive selected (or any row)

[Jan Karel Pieterse]

After downloading, did you unblock the file?
In explorer, right-click, choose properties, check the unblock box close to the bottom of the properties window. Then open the file and enable macros. It worked just fine for me.

[xDroptek]

sorry for the late reply jan been busy with work,

ive got the sheet working now with the highlight and Undo/redo function, however now im getting a run-time error 1004 "paste method of worksheet class failed"
in the debug it seems to be on Module 2 and is highlighting he activesheet.paste in yellow any idea on whats happening there?

awesome work so far thanks heaps for helping saved me so much time

[xDroptek]

Hey Jan,

Ive also found another issue, the code was working then once i close the sheet and reopen it the Highlight goes away.....just isnt there.
im still getting the Paste issue.
also can i create a macro to create paste a code to a VBA worksheet, reason being my macro wont work because the highllight is in the background, so the VBA will create the code for the highlight function AFTER the main macro is completed.
sorry if this gives you a headache...

[Jan Karel Pieterse]

Does this version of your Import routine do better?

Sub Import(strFileName As String)
    Workbooks(strFileName).Worksheets("EstimateOne").Visible = True
    Windows("1.xlsx").Worksheets("RFP-EOIs").Cells.Copy Workbooks(strFileName).Worksheets("EstimateOne").Range("A1")
    Call DeleteEmailErrors
    Workbooks(strFileName).Worksheets("Pivot").Visible = True
    Workbooks(strFileName).Sheets("Pivot").PivotTables("PivotTable2").PivotCache.Refresh
    Workbooks(strFileName).Sheets("Pivot").Range("A2:G4012").Copy Workbooks(strFileName).Worksheets("Consolidated").Range("A10")
End Sub

[xDroptek]

Hi jan,

i get a runtime error "object dosent support this property or method"
somthing with the below

Windows("1.xlsx").Worksheets("RFP-EOIs").Cells.Copy Workbooks(strFileName).Worksheets("EstimateOne").Range("A1")

[Jan Karel Pieterse]

Hmm, perhaps a mistake on my end. Try replacing the word Windows with Workbooks.

[xDroptek]

cheers Jan that seems to have worked although the Highlight row was working until i closed and reopened the sheet now i cannot get it to work again any ideas?