PDA

View Full Version : How to stop screen flashing



fiza
03-06-2010, 03:04 AM
Hi Anyone,

I have a worksheet with a table in it. and my workbook contains macros and modules. My problem is when I enter a value to a cell in the sheet. the excel sheet flashes. I want to know how this can be prevented.

Regards
fiza

lucas
03-06-2010, 07:29 AM
Hi fiza, welcome to the board.

It sounds like you have some code the the sheet module and you might help the screen flashing by adding this to the beginning of the code:

Application.ScreenUpdating = False

Don't forget you need to reset it to true at the end of the module.

Application.ScreenUpdating = True

fiza
03-07-2010, 02:56 AM
Below is the VB a code that I’m using to find the duplicate values in an excel sheet.

When the button is clicked, it asks to specify the range where I want to find the duplicate for.

Meaning I have to click the column number.

When the range is given, it then shows a dialogue box saying that these numbers of duplicates were found.
It also gives me a message box to delete the duplicate value.

What I want is when the button is clicked, only the duplicate rows to be visible & highlighted in yellow.

When the duplicate row is deleted. The sheet will show all the rows of the sheet back again.

Sub Find_RemoveDuplicates()

Dim cRow As Long
Dim lRow As Long
Dim sCell As Range
Dim D As Long

lRow = GetLastRowWithData

On Error Resume Next
Set sCell = Application.InputBox(Prompt:= _
"Select Starting Row of Column with Duplicate values.", _
Title:="Select Column", Type:=8)

On Error GoTo 0
If sCell Is Nothing Then
Exit Sub
End If

sCell.Select

If Selection.Cells.Count > 1 Then
MsgBox ("Pls select Single Cell only")
Exit Sub

Else

dCol = ActiveCell.Column
sRow = ActiveCell.Row

For cRow = lRow To sRow Step -1
If IsEmpty(Cells(cRow, dCol)) = False Then
If WorksheetFunction.CountIf(Range(sCell, Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then
Cells(cRow, dCol).Interior.Color = 255 'This Marks the duplicate values as Red
D = D + 1
End If
End If
Next cRow

If D = 0 Then

MsgBox ("No Duplicate Values Found")

Else

caution = MsgBox(D & " Duplicate entries selected and marked RED" & vbCrLf & _
"Do you want to delete them? " & vbCrLf & _
"Entire Row for the marked entries will be deleted. " & vbCrLf & _
"Do you want to Continue?", vbYesNo, "Confirmation")

If caution = vbYes Then

For cRow = lRow To sRow Step -1
If IsEmpty(Cells(cRow, dCol)) = False Then
If WorksheetFunction.CountIf(Range(sCell, Cells(cRow, dCol)), Cells(cRow, dCol).Text) > 1 Then
Cells(cRow, dCol).EntireRow.Delete ' This deletes the entire row
End If
End If
Next cRow

End If
End If
End If

End Sub

'********************************************************************
'* UDF to Get Last Row with Data on worksheet *
'********************************************************************

Public Function GetLastRowWithData() As Long

Dim ExcelLastCell As Object, lRow As Long, lLastDataRow As Long, l As Long

Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
lLastDataRow = ExcelLastCell.Row
lRow = ExcelLastCell.Row

Do While Application.CountA(ActiveSheet.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop

lLastDataRow = lRow
GetLastRowWithData = lLastDataRow

End Function

Regards
fiza