write at exceltoexplore@gmail.com : Report Automation|Dashboard in Excel| Provide Excel consulting through macro (VBA) automation |Financial Modeling | Ethical Hacking

Sunday, 21 August 2011

Hide and Unhide Rows based on colours

If you want to hide and unhide rows based on colour you can use below code.
Excel 2007 provide option of filter by colour but below 2007 version you can not.

Sub Mtest()
Dim c As Range
On Error Resume Next
With ActiveSheet
For Each c In .Range("A1:A100")
If c.Interior.ColorIndex <> 6 Then c.EntireRow.Hidden = Not c.EntireRow.Hidden
Next c
End With
On Error GoTo 0
End Sub

Monday, 15 August 2011

Open particular file , search fo text & retrive results

If you want to search particular text in any wrokbook & want to retrive all the results
on  active sheet then use below code
change file name & path as per your requirement

Sub Mtest()
Dim found As Range
Dim wbk1 As Workbook, wbk2 As Workbook
Dim output As Range
Dim sht As Worksheet
Dim broker As String
Dim start As String
Set wbk1 = ThisWorkbook
broker = InputBox("Enter the string to search for")
Set output = wbk1.Worksheets("Sheet1").Range("A1")
'change your file name and path here
Set wbk2 = Application.Workbooks.Open("C:\Users\MAHESH\Desktop\searchfile.xls")
With wbk2
For Each sht In wbk2.Worksheets
Set found = sht.Cells.Find(what:=broker, after:=ActiveCell, LookIn:=xlFormulas, Lookat:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not found Is Nothing Then
start = found.Address
Set found = sht.Cells.FindNext(found)
output.Value = found.Value
Set output = output.Offset(1, 0)
Loop While Not found Is Nothing And found.Address <> start
End If
Next sht
End With

Count the Number of times file open

This requirement came from one of forum
Assuming your counter in cell "F2"
Try below code in thisworkbook model
whenever you open the workbook this number will increase by one

Private Sub Workbook_Open()
Sheets("Sheet1").Range("F2").Value = Sheets("Sheet1").Range("F2").Value + 1
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
End Sub

Wednesday, 10 August 2011

Delete Rows contain Zero

Try :

Sub Mtest()
Dim LR As Long, r As Long
LR = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LR To 1 Step -1
If Application.WorksheetFunction.CountIf(Rows(r), "=0") = 1 Then Rows(r).Delete
Next r
Application.ScreenUpdating = True
End Sub

Lock cell once you enter data

1.First select all cells (Ctrl + A) on worksheet
2.Right Click & Go to Format cells
3.Select Protection Tab
4.uncheck Locked
5.Right Click on sheet tab & select view code
6.Paste below code
Private Sub Worksheet_Change(ByVal Target As Range)
Const pw As String = "password"
With Me
.Unprotect pw
 Target.Locked = True
.Protect pw
End With
End Sub