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



    Do

    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



myNext:

    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, ";"))

    Else:



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

    End If

   

    Columns("A:A").AutoFit

End Sub

Convert all picture in folder to single pdf using Excel VBA

Hi,

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


sh.Delete


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..

Cheers!!

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

'sObject.Delete

End If

Next

End Sub

Do let me update your views, 

Cheers!!

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.

Click here to download sheet

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

Hi,

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.

Explanation:

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..

Download

Cheers!!