Tuesday, December 30, 2014

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



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

        SkipBlanks:=False, Transpose:=False

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

Application.CutCopyMode = False


Next n

Application.ScreenUpdating = True

MsgBox "Done!!"


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


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.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)
ActiveSheet.Protect Password:="password"
End Sub

Tuesday, December 16, 2014

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
                .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.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)
    ActiveChart.Export Filename:=ThisWorkbook.Path & "\" & "x01z9.jpg", FilterName:="JPEG"
'Adding back rotated pic to comment
                .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
                 Kill (ThisWorkbook.Path & "\"  "x01z9.jpg")
                End With
        End If
    Next cll
End Sub

Wednesday, December 10, 2014

Get Cordinates

GSM LAC/CID -> location test
Bahri Okuroglu
MCC - Mobile Country Code
MNC - Mobile Network Code
LAC - Location Area Code
CID - Cell ID

Sunday, December 7, 2014

DATEDIF a hidden excel function

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


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. 


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:

Saturday, December 6, 2014

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


Wednesday, December 3, 2014

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