Tuesday, June 23, 2015

Find text in all sheet & return Sheet Name & Header in new Excel sheet

You can use below code for find particular text in all sheets

'Run from standard module, like: Module1.

    'Find all data on all sheets!

    'Do not search the sheet the found data is copied to!

    'List a message box with all the found data addresses, as well!

    Dim ws As Worksheet, Found As Range

    Dim myText As String, FirstAddress As String

    Dim AddressStr As String, foundNum As Integer

    myText = InputBox("Enter text to find")

    If myText = "" Then Exit Sub

    For Each ws In ThisWorkbook.Worksheets

    With ws

    'Do not search sheet4!

    Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

    If Not Found Is Nothing Then

    FirstAddress = Found.Address


    foundNum = foundNum + 1

    'AddressStr = AddressStr & .Name & "," & Found.Address & vbCrLf

    AddressStr = AddressStr & .Name & "//" & Found.Address & "//" & ws.Cells(1, Found.Column).Value & ";" & vbCrLf

    Set Found = .UsedRange.FindNext(Found)

    'Copy found data row to sheet4 Option!

    'Found.EntireRow.Copy _

    'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)

    Loop While Not Found Is Nothing And Found.Address <> FirstAddress And Found.Column <> Range(FirstAddress).Column

    End If


    End With

    Next ws

    If Len(AddressStr) Then

    MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _

    AddressStr, vbOKOnly, myText & " found in these cells"


    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))

    ws.Name = "Report"


    Range("A1").Resize(foundNum, 1) = Application.Transpose(Split(AddressStr, ";"))


    MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation

    End If



End Sub

Saturday, June 20, 2015

Convert all picture in folder to single pdf using Excel VBA


Photographer n Artist can now send all their pic in one PDF to client instead of zip file...Following code will help them to import all pictures stored in folder & convert them to handy PDF which can be shared on the go...

Sub Add_PIC_Save_PDF() Dim strPath As String Dim strFileName As String Dim Pic As Picture Dim sh As Worksheet Dim n As Integer Dim cl As Range Application.DisplayAlerts = False Application.ScreenUpdating = False n = ThisWorkbook.Worksheets.Count strPath = "C:\Users\ABC\Desktop\test\" ' change folder to suit strFileName = Dir(strPath & "*.png") ' change file type to suit Set sh = ActiveSheet Do While Len(strFileName) > 0 sh.Select Set Pic = ActiveSheet.Pictures.insert(strPath & strFileName) Range("A1").Select With sh Set cl = sh.Range("A1") With PicSize PicSize.Top = cl.Top PicSize.Left = cl.Left PicSize.Placement = xlMoveAndSize End With With sh.PageSetup .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = 1 .Zoom = False .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintQuality = 4000 End With strFileName = Dir End With Set sh = Sheets.Add(After:=Sheets(Sheets.Count)) Loop
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\ImageToPdf.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Do let me know your views..


Monday, June 15, 2015

Hide / delete all shapes/pictures falling on particular range in sheet

Hi Friends

Many time you need to clear all unwanted shapes from particular range by deleting or hiding, and since shapes/ pictures doesn't reside in cells but floats above it which makes it difficult to manage, we can use following code to manage floating shop per our need:

Sub Hide_Shapes()

Dim s As String

Dim sObject As Shape

Dim rng As Range

Set ws = ActiveSheet

'Set ws = ActiveWorkbook.Worksheets("Sheet1")

Set rng = ws.Range("A:C,BC:BD")

For Each sObject In ws.Shapes

With sObject

s = .TopLeftCell.Address & ":" & .BottomRightCell.Address

End With

If Not Intersect(rng, ws.Range(s)) Is Nothing Then

sObject.Visible = msoFalse

'use below line for deleting shape


End If


End Sub

Do let me update your views, 

Sunday, June 14, 2015

Excel Macro - Sheet Manager

Hi Excel champs,

Today i want o share with you a powerful macro for those who are dealing with lots of sheets in single book & wish to hide unhide sheet very frequently..

This macro has module wherein on loading this you will get 2 listboxes, listbox1 will show all visible sheets & listbox2 will show all hidden sheets..

If you want to hide any sheets from those visible ones, juts select sheet name one by one from left listbox & click on 1st button (>) in center..

If you want to unhide any sheets from those hidden ones, juts select sheet name one by one from right listbox & click on 2nd button (<) in center..

On contrary if you want to hide all visible sheets then click 3rd button (>>>) in center & if you want to unhide all hidden sheets then click 4th button (<<<).

And if you have loads of sheet then above all list box there is one textbox to filter sheets, just type name of sheet & data will get filtered & select sheet name & push it to opposite side.

Please note you can not hide all sheet so i have kept sheet named "Main" out of reach of code which will be by default visible..

Also you can double click on name of item appearing listbox to move that on opposite side & after that click button Hide / Unhide to give impact..

You can also use shortcut key Ctr + Shft + W to load Sheet Manager macro.

Let me know if you liked it or not.

Monday, June 8, 2015

Transpose data from Table to One Column / Multiple rows with heading


We know trick to transpose data from row to column & vice versa, however in the edge of ERP many system requires data in Table to be transposed in to one column which is very difficult to do manually when you have n numbers of rows of data.

Formula used is offset x no. of Rows & y no. of column from Starting cell.

here you can name your starting cell as START by going to name manager,

--Number of row to be offset is 2 divide by number of columns in table;
--Number of column to be offset is "z" divide by "z" divide where z is number of columns in table;

Refer attached sheet with formula to do so..