Macro for Importing all files in folder to active sheet

Macro for Importing all files in folder to active sheet..

Sub Data_Merge_All_Files_SelectFolder_NO_ADO()

Dim bookList As Workbook

Dim FileName As Variant

Dim n As Long

Dim disWB As Workbook



Set disWB = ActiveWorkbook

FileName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

Application.ScreenUpdating = False



For n = LBound(FileName) To UBound(FileName)

Set bookList = Workbooks.Open(FileName(n))

Range("A2:Q50" & Range("A65536").End(xlUp).Row).Copy

disWB.Worksheets(1).Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False



Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

Application.CutCopyMode = False

bookList.Close

Next n

Application.ScreenUpdating = True


MsgBox "Done!!"


END SUB

How to insert rows or delete rows in a protected excel sheet

Hi,

While inserting row first you need to enter how many rows to be inserted & then select cell after which rows to be inserted..

For deleting row you will be prompted for selecting cell for which you need to delete rows.

'Macro for Inserting rows

Sub Insert_Row()



Dim n As Integer 'number of rows to insert

Dim rng As Range




n = Application.InputBox("How many rows you need to insert?", Type:=2)

Set rng = Application.InputBox("Select cell after which you want to insert row?", Type:=8)

ActiveSheet.Unprotect Password:="password"

rng.Select

rng.Resize(n, 1).EntireRow.Insert shift:=xlDown

ActiveSheet.Protect Password:="password"

End Sub





'Macro for Deleting rows


Sub Delete_Rows()

Dim rng As Range

ActiveSheet.Unprotect Password:="password"

Set rng = Application.InputBox("Select cell after which you want to insert row?", Type:=8)

rng.EntireRow.Delete

ActiveSheet.Protect Password:="password"

End Sub

Excel VBA add picture in comment box & rotate it

Code for doing same is given below:

Option Explicit
Sub InsertPictures()
    Dim cll As Range
    Dim Rng As Range
    Dim strPath As String
    Dim objChart1 As ChartObject
    Dim pic As Object
    strPath = "D:\Photo Folder"
    With Sheets("Sheet1")
        Set Rng = Range("A2:A416")
    End With
    For Each cll In Rng
        If Dir$(strPath & "\" & cll.Value & ".jpg") <> "" Then
            With cll
'Adding comment
                .ClearComments
                .AddComment ("")
                .Comment.Shape.Fill.UserPicture (strPath & "\" & cll.Value & ".jpg")
                .Comment.Shape.Height = 600 '160
                .Comment.Shape.Width = 400 '120
                .Comment.Shape.LockAspectRatio = msoTrue
                .Comment.Visible = True
'Copy paste picture/duplicating picture
                .Comment.Shape.Select
                .Comment.Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                .Comment.Visible = False
                .Offset(0, 1).PasteSpecial
'Rotating Picture    
Selection.ShapeRange.IncrementRotation 270#
Set pic = Selection.ShapeRange
'Creating chart object pasting picture in it & exporting to temp file    
    Set objChart1 = ActiveSheet.ChartObjects.Add(100, 100, 200, 160)
    objChart1.Activate
    ActiveSheet.Shapes(pic.Name).Copy
    ActiveChart.Paste
    ActiveChart.Export Filename:=ThisWorkbook.Path & "\" & "x01z9.jpg", FilterName:="JPEG"
'Adding back rotated pic to comment
                .Select
                .ClearComments
                .AddComment ("")
                .Comment.Visible = True
                .Comment.Shape.Height = 120
                .Comment.Shape.Width = 160
                .Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\" & "x01z9.jpg"
                '.Comment.Shape.Fill.UserPicture (strPath & "\" & cll.Value & ".jpg")
'Clearing temp objects
                 pic.Delete
                 objChart1.Select
                 objChart1.Delete
                 Kill (ThisWorkbook.Path & "\"  "x01z9.jpg")
                End With
        End If
    Next cll
End Sub

Get Cordinates

Bahri Okuroglu

MCC - Mobile Country Code
MNC - Mobile Network Code
LAC - Location Area Code
CID - Cell ID

DATEDIF a hidden excel function

 DATEDIF returns the difference between two date values, based on the interval specified.

SYNTAX

The syntax for the Microsoft Excel DATEDIF function is:


DATEDIF( start_date, end_date, interval )

Here Interval could be one of Y, M, D or YM, YD, MD. 

Where:

Y gives the number of complete years between two dates.
M gives the number of complete months between two dates &
D  gives the number of days between two dates.

Since we got competed year in Y parameter, month in M parameter, reminder can be obtained using following parameters;

YM gives the difference between the months here days and years are ignored.

YD gives the difference between the days and years and dates are ignored.

Whereas MD gives the difference between the days and months and years are ignored.

See below for example:

Multi column Combo Box

Multi column combo box..

Have you ever come across situation wherein you want to show multiple items in combo box with description, but on selection you want to restrict it to only 1st item..

So we will have different view item in combo box & different result value.

See attached file for such example.

Click to Download

Cheers!!

Calculate Quarterly totals from monthly data using formula

Calculate Quarterly totals from monthly data!

You have Months Jan to Dec in Column A & against the same in column B you have Revenue figure, now lets see how we can calculate Quarterly total of revenue using sumproduct.

Formula is:
For Q1 =SUMPRODUCT((ROUNDUP(MONTH($A$2:$A$13)/3,0)=1)*$B$2:$B$13)

For Q2 =SUMPRODUCT((ROUNDUP(MONTH($A$2:$A$13)/3,0)=2)*$B$2:$B$13)

And so on..

Copy data from one named range to another location in excel using VBA

In VBA use this code:

Names("DefinedName").RefersToRange.Cells.Copy Sheets("sheet2").Range("a1")

wherein DefinedName is your name for which data to be copied..
shee2 is sheet name to which data tobe copied
a1 is destination cell in sheet2.

'For copying data from one named cells to another
    sName.RefersToRange.Cells.Copy (dName.RefersToRange.Cells)


'For copying data from named cells to range
    sName.RefersToRange.Cells.Copy dCells

Welcome

Welcome