Excel : Find Excel Version

Try :


Sub Mtest()
Dim EVer As String
'Find excel EVersion
Select Case Application.Version
Case "5.0"
EVer = "Excel 5"
Case "7.0"
EVer = "Excel 95"
Case "8.0"
EVer = "Excel 97"
Case "9.0"
EVer = "Excel 2000"
Case "10.0"
EVer = "Excel 2002"
Case "11.0"
EVer = "Excel 2003"
Case "12.0"
EVer = "Excel 2007"
Case Is = "14.0"
EVer = "Excel 2010"
Case Else
EVer = "Unknown EVersion"
End Select
With Application
MsgBox EVer & vbCr & "Version: " & .Version & " Build: " & .Build
End With
End Sub

Excel : Find Sring in all worksheets Highlight cell and Zoom the excel worksheet

This requirement came from forum & most appreciated thing in this is to Zoom the excel worksheet. once the search string is found.  Zoom is used because that person has eyesight problem so he can view the result clearly.

1. Enter Search string/Value in input box
2. it will search for string/vlaue in all the worksheets of workbook
3. it will give you cell address of the search string/value if found
4. Excel worksheet will be zoom Out and Zoom in again
5. Found result will be highlighted
6. it will give you pop up , whether you want to clear highlighting ?

Sub Mtest()
Dim found As Range
Dim m As String, Temp As String
Dim count As Integer
Dim ws As Worksheet
count = 0
m = InputBox(prompt:="Enter value for search", Title:="Excel Find")
For Each ws In ActiveWorkbook.Worksheets
Set found = ws.Cells.Find(What:=m, LookIn:=xlValues, lookat:=xlPart)
If Not found Is Nothing Then
count = count + 1
MsgBox found.Worksheet.Name & found.Cells.Address, Title:="Excel Find"
'found.Cells.Interior.ColorIndex = 6
With found.Cells.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3
End With
ActiveWindow.Zoom = ActiveWindow.Zoom + 50
Application.Wait Now + TimeValue("00:00:02")
ActiveWindow.Zoom = ActiveWindow.Zoom - 50
Temp = MsgBox(prompt:="Clear highlighting", Title:="Excel Find", Buttons:=vbOKCancel + vbQuestion)
'If Temp = vbOK Then found.Cells.Interior.ColorIndex = xlNone
If Temp = vbOK Then found.Borders.LineStyle = xlNone
End If
Next ws
If count = 0 Then MsgBox prompt:="Not found", Title:="Excel Find"
End Sub

Excel : Count Number of Cells Colour in Row

Try below code to count the rowwise number of colour cells.
i have hardcode the column value. even comment (A macro comment is a piece of text in a macro which will not be executed by Excel VBA. It is only there to provide you information about the macro)
the lines which provide the last column

the person from this requirement came she used to count the colour rows manually. in actual file there are around 191 columns day wise & rows contain employee names. its hours of work with this code now in fraction of second.

Sub Mtest()
Dim countcolor As Long, ColorCount As Long
Dim i As Long, LC As Long
'LC = Cells(3, Columns.Count).End(xlToLeft).Column
'change row here
For i = 3 To Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
ColorCount = 0
For Each c In Range(Cells(i, 5), Cells(i, 191)) 'change column count here
'For Each c In Range(Cells(i, 5), Cells(i, LC)) 'change column count here
If c.Interior.ColorIndex = 3 Then ColorCount = ColorCount + 1
Next c
countcolor = ColorCount
Cells(i, 191).Offset(0, 2).Value = countcolor
'Cells(i, LC).Offset(0, 1).Value = countcolor
Next i
End Sub


I have taken Red colour in above example .(Interior.ColorIndex = 3)
Excel Color Palette has an index of 56 colors which can be modified using VBA. Each color in the palette is associated with a unique value in the index that can be changed programatically. At times it is useful to know the relative positioning of the various colors within this index as well as how various versions of Excel treat colors

Excel : Unlock Workbook And Unlock Worksheet

If you have forgotten your workbook or worksheet password. You will find below information helpful to unprotect excel workbook or worksheet password

The code below can unlock a workbook password and sheet passwords

Module provides Excel workbook and sheet unlock routines. The algorithm

relies on a backdoor password that can be 1 to 9 characters long where each

character is either an "A" or "B" except the last which can be any character

from ASCII (American Standard Code for Information Interchange) code 32 to 255.Implemented as a regular module for use with any Excel VBA project.

Code by : Kevin M. Jones

Option Explicit

Private Sub DisplayStatus( _

ByVal PasswordsTried As Long _

)

' Display the status in the Excel status bar.

' Syntax

' DisplayStatus(PasswordsTried)

' PasswordsTried - The number of passwords tried thus far.

Static LastStatus As String

LastStatus = Format(PasswordsTried / 57120, "0%") & " of possible passwords tried."

If Application.StatusBar <> LastStatus Then

Application.StatusBar = LastStatus

DoEvents

End If

End Sub

Private Function TrySheetPasswordSize( _

ByVal Size As Long, _

ByRef PasswordsTried As Long, _

ByRef Password As String, _

Optional ByVal Base As String _

) As Boolean

' Try unlocking the sheet with all passwords of the specified size.

' TrySheetPasswordSize(Size, PasswordsTried, Password, [Base])

' Size - The size of the password to try.

' PasswordsTried - The cummulative number of passwords tried thus far.

' Password - The current password.

' Base - The base password from the calling routine.

Dim Index As Long

On Error Resume Next

If IsMissing(Base) Then Base = vbNullString

If Len(Base) < Size - 1 Then

For Index = 65 To 66

If TrySheetPasswordSize(Size, PasswordsTried, Password, Base & Chr(Index)) Then

TrySheetPasswordSize = True

Exit Function

End If

Next Index

ElseIf Len(Base) < Size Then

For Index = 32 To 255

ActiveSheet.Unprotect Base & Chr(Index)

If Not ActiveSheet.ProtectContents Then

TrySheetPasswordSize = True

Password = Base & Chr(Index)

Exit Function

End If

PasswordsTried = PasswordsTried + 1

Next Index

End If

On Error GoTo 0

DisplayStatus PasswordsTried

End Function

 

Private Function TryWorkbookPasswordSize( _

ByVal Size As Long, _

ByRef PasswordsTried As Long, _

ByRef Password As String, _

Optional ByVal Base As String _

) As Boolean

' Try unlocking the workbook with all passwords of the specified size.

' TryWorkbookPasswordSize(Size, PasswordsTried, Password, [Base])

' Size - The size of the password to try.

' PasswordsTried - The cummulative number of passwords tried thus far.

' Password - The current password.

' Base - The base password from the calling routine.

Dim Index As Long

On Error Resume Next

If IsMissing(Base) Then Base = vbNullString

If Len(Base) < Size - 1 Then

For Index = 65 To 66

If TryWorkbookPasswordSize(Size, PasswordsTried, Password, Base & Chr(Index)) Then

TryWorkbookPasswordSize = True

Exit Function

End If

Next Index

ElseIf Len(Base) < Size Then

For Index = 32 To 255

ActiveWorkbook.Unprotect Base & Chr(Index)

If Not ActiveWorkbook.ProtectStructure And Not ActiveWorkbook.ProtectWindows Then

TryWorkbookPasswordSize = True

Password = Base & Chr(Index)

Exit Function

End If

PasswordsTried = PasswordsTried + 1

Next Index

End If

On Error GoTo 0

DisplayStatus PasswordsTried

End Function

 

Public Sub UnlockSheet()

' Unlock the active sheet using a backdoor Excel provides where an alternate

' password is created that is more limited.

Dim PasswordSize As Variant

Dim PasswordsTried As Long

Dim Password As String

PasswordsTried = 0

If Not ActiveSheet.ProtectContents Then

MsgBox "The sheet is already unprotected."

Exit Sub

End If

On Error Resume Next

ActiveSheet.Protect ""

ActiveSheet.Unprotect ""

On Error GoTo 0

If ActiveSheet.ProtectContents Then

For Each PasswordSize In Array(5, 4, 6, 7, 8, 3, 2, 1)

If TrySheetPasswordSize(PasswordSize, PasswordsTried, Password) Then Exit For

Next PasswordSize

End If

If Not ActiveSheet.ProtectContents Then

MsgBox "The sheet " & ActiveSheet.Name & " has been unprotected with password '" & Password & "'."

End If

Application.StatusBar = False

End Sub

 

Public Sub UnlockWorkbook()

' Unlock the active workbook using a backdoor Excel provides where an alternate

' password is created that is more limited.

Dim PasswordSize As Variant

Dim PasswordsTried As Long

Dim Password As String

PasswordsTried = 0

If Not ActiveWorkbook.ProtectStructure And Not ActiveWorkbook.ProtectWindows Then

MsgBox "The workbook is already unprotected."

Exit Sub

End If

On Error Resume Next

ActiveWorkbook.Unprotect vbNullString

On Error GoTo 0

If ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows Then

For Each PasswordSize In Array(5, 4, 6, 7, 8, 3, 2, 1)

If TryWorkbookPasswordSize(PasswordSize, PasswordsTried, Password) Then Exit For

Next PasswordSize

End If

If Not ActiveWorkbook.ProtectStructure And Not ActiveWorkbook.ProtectWindows Then

MsgBox "The workbook " & ActiveWorkbook.Name & " has been unprotected with password '" & Password & "'."

End If

Application.StatusBar = False

End Sub

Excel : Fill up Blank Rows in a column

If you your columns have blank rows & data. And you want to fill up blank rows with cells having data.
e.g cell A2 contain 1 and cell A10 contain 2. Rows are blank from A3:A9. try below code which will fill up value if cell A2 till cell A9

Sub Mtest()
Dim i As Long
Dim Temp As String

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Trim((Cells(i, 1)) = "") Then
Cells(i, 1) = Temp
Else
Temp = Cells(i, 1)
End If
Next
End Sub