Sunday, September 30, 2012

How to Create a Folder by Current Date and Time then Export Active Sheet Data to a New Workbook by Active Sheet Name using Macro

Excel VBA Macro to Create a Folder By Current Date And Time ,Export Active Sheet Data to a New Workbook By Active Sheet Name
'This is a Very User Friendly and Power Full Utility Macro which Exports Data From Active Sheet to a New Work Book
'The New Work Book is Created with Active Sheet Name and It has only one Sheet having Active Sheet Name & Data.
'We can use this Macro To Save Dalily Tasks from 'Regular Task Workbook' to a WorkBook with Current Date & Time\

Sub CrtTaskShtByToday()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim F As String
Dim B As String
Dim S As String
Dim W As Worksheet

On Error Resume Next
Application.DisplayAlerts = False

X = Day(Date) 'Day Value From Date
Y = Month(Date) 'Month Value From Date
Z = Year(Date) 'Year Value From Date
F = X & "-" & Y & "-" & Z

B = Workbooks("MainTask").ActiveSheet.Name 'B=New Book Name
S = Workbooks("MainTask").ActiveSheet.Name 'S=Sheet Name In New Book

MkDir "D:\" & F 'Make a Desired Folder By Current Date & Time

Workbooks(B).Close 'Closes Exported Data Book If It Opens
Workbooks.Add.SaveAs ("D:\" & F & "\" & B & ".xlsx")

'New Book Open By Active Sheet Name To Export Data
'A New Book In a Folder with Current Date& Time will be created

Workbooks(B).Sheets.Add.Name = S
'A Sheet Name same As Book Name Will Be Created

Workbooks("MainTask").Activate
ActiveWorkbook.ActiveSheet.Cells.Copy Workbooks(B).Sheets(S).Range("a1")

'Copies Data from Active Sheet of Active WorkBook to a Newley Created Book with the same Sheet Name

For Each W In Workbooks(B).Worksheets
If W.Name <> Sheets(S).Name Then
W.Delete
End If ' Deletes Additional Sheets Except Data Sheet in a New Book
Next W

Workbooks(B).Save 'Your New Exported Data Book
Workbooks(B).Close
End Sub
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Friday, September 28, 2012

Excel VBA Macro To Count No.of All Rows and Columns In a Active Sheet

Excel VBA Macro To Count No.of All Rows and Columns In a Active Sheet
Sub CountAllRowsCols()
Dim X As Long
Dim Y As Integer


X = ActiveWorkbook.ActiveSheet.Rows.Count
Y = ActiveWorkbook.ActiveSheet.Columns.Count

MsgBox "The Total No.of Rows= " & X & " :: " & "The Total No.of Columns= " & Y

End Sub

Thanks,Tamatam

How To Export Active Sheet Data to a New Workbook By Active Sheet Name

Excel VBA Export Active Sheet Data to a New Workbook By Active Sheet Name
'Macro To Create a Folder By Current Date And Time ,Export Active Sheet Data to a New Workbook By Active Sheet Name
'This is a Very User Friendly and Power Full Utility Macro which Exports Data From Active Sheet to a New Work Book.
'The New Work Book is Created with Active Sheet Name and It has only one Sheet having Active Sheet Name& Data.
'We can use this Macro To Save Daily Tasks from 'Regular Task Workbook' to a WorkBook with Current Date & Time

Sub CrtTaskShtByToday()

Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim F As String
Dim B As String
Dim S As String
Dim W As Worksheet

On Error Resume Next

Application.DisplayAlerts = False

X = Day(Date) 'Day Value From Date

Y = Month(Date) 'Month Value From Date
Z = Year(Date) 'Year Value From Date
F = X & "-" & Y & "-" & Z

B = Workbooks("MainTask").ActiveSheet.Name 'B=New Book Name

S = Workbooks("MainTask").ActiveSheet.Name 'S=Sheet Name In New Book

MkDir "D:\" & F 'Make a Desired Folder By Current Date & Time


Workbooks(B).Close 'Closes Exported Data Book If It Opens


Workbooks.Add.SaveAs ("D:\" & F & "\" & B & ".xlsx")

'New Book Open By Active Sheet Name To Export Data
'A New Book In a Folder with Current Date& Time will be created

Workbooks(B).Sheets.Add.Name = S

'A Sheet Name same As Book Name Will Be Created
Workbooks("MainTask").Activate
ActiveWorkbook.ActiveSheet.Cells.Copy Workbooks(B).Sheets(S).Range("a1")
'Copies Data From Active Sheet of Active WorkBook to a Newley Created Book With The Same Sheet Name

For Each W In Workbooks(B).Worksheets

If W.Name <> Sheets(S).Name Then
W.Delete
End If ' Deletes Additional Sheets Except Data Sheet in a New Book
Next W

Workbooks(B).Save 'Your New Exported Data Book

Workbooks(B).Close

End Sub


Thanks,Tamatam

Wednesday, September 26, 2012

How To Create a Folder and a Excel File By Current Date And Time

Macro To Create a Folder and a Excel File By Current Date And Time
'We can use this Macro To Save Dalily Tasks from 'Regular Task Workbook' to a WorkBook with Current Date & Time

Sub CrtTaskShtByToday()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim e As String
On Error Resume Next
Application.DisplayAlerts = False

A = Day(Date) 'Day Value From Date
B = Month(Date) 'Month Value From Date
C = Year(Date) 'Year Value From Date
E = A & "-" & B & "-" &C

MkDir "D:\MyXlProjects\" & e 'Make a Desired Folder By Current Date & Time
Workbooks(e).Close

Workbooks.Add.SaveAs ("D:\MyXlProjects\" & E & "\" & E & ".xlsx")
'A Folder & File with Current Date& Time will be created

Workbooks("MainTask").Activate
ActiveWorkbook.ActiveSheet.Cells.Copy Workbooks(e).Sheets("Sheet1").Range("a1")
'Copy Data From Active Sheet to a Sheet1 of Newly Created Workbook

Workbooks(e).Save
Workbooks(e).Close
End Sub

Thanks,Tamatam

How to Auto Fill Default, Auto Fill Series in Excel using VBA

Excel VBA Macro to Auto Fill Default, Auto Fill Series
MODEL 1:
'Macro To AutoFillDefault :
'This Is A User Friendly Macro which Works Based on User Selection
Sub FillDefault()
For X = 1 To 100
Selection.AutoFill Range(ActiveCell.Offset(X, 0), ActiveCell.Offset(0, 0)), xlFillDefault
Next X
End Sub

'Macro To AutoFillSeries :
'This Is A User Friendly Macro which Works Based on User Selection
Sub FillSeries()
For X = 1 To 100
Selection.AutoFill Range(ActiveCell.Offset(X, 0), ActiveCell.Offset(0, 0)), xlFillSeries
Next X
End Sub
-----------------------------------------------------------------------
MODEL 2:
Macro To AutoFillSeries :
Sub AutoFillSeries()
'If You Know Active Cell Then You Can AutoFillSeries As
'Syntax 1:
Cells(2, 1).AutoFill Range("A2:A100"), xlFillSeries
'Syntax 2:
Cells(2, 1).AutoFill Destination:=Range("A2:A100"), Type:=xlFillSeries
End Sub

Macro To AutoFillDefault :
Sub AutoFillDefault()
'If You Know Active Cell Then You Can AutoFillDefault As
'Syntax 1:
Cells(2, 1).AutoFill Range("A2:A100"), xlFillDefault
'Syntax 2:
Cells(2, 1).AutoFill Destination:=Range("A2:A100"), Type:=xlFillDefault
End Sub

Thanks,Tamatam

Tuesday, September 25, 2012

Excel VBA Macro To Concatenate each Sheet Data In Main Sheet

Excel VBA Macro To Concatenate each Sheet Data In Main Sheet
Sub ConcateSheets()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer

Dim W As Worksheet
Dim A As Integer

A = 0 'Variable for Column Increment In Main Sheet

For Each W In Worksheets
If W.Name <> Sheets("MAIN").Name Then
W.Activate

For X = 1 To 10
If Cells(X, 1) <> "" Then

Z = Z + 1 'Row Increment Variable

For Y = 1 To 26
Sheets("MAIN").Cells(Z, A + Y) = W.Cells(X, Y)
If Cells(1, Y) = "" Then Exit For
Next Y

End If
Next X

A = A + Y - 1 'Variable for Columns Join In Main Sheet

End If
Z = 0
Next W
End Sub

Note:
Each Column of Each Sheet Comes Side By Side(Concatenation Mode) in Main Sheet.

Thanks,Tamatam

Excel VBA Macro To Concatenate First Column of Each Sheet In Main Sheet

Excel VBA Macro To Concatenate First Column of Each Sheet In Main Sheet
Sub ConcateColumns()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim W As Worksheet
Dim A As Integer

A = 1 'Variable for Column Increment In Main Sheet

For Each W In Worksheets

If W.Name <> Sheets("MAIN").Name Then
W.Activate

For X = 1 To 100

If Cells(X, 1) <> "" Then
Z = Z + 1 'Row Increment Variable
Sheets("MAIN").Cells(Z, A) = W.Cells(X, 1)
End If

Next X
A = A + 1 'Variable for Column Increment In Main Sheet

End If
Z = 0

Next W
End Sub

Note:
First Column of Each Sheet Comes Side By Side(Concatenation Mode) in Main Sheet.

Thanks,Tamatam

How To Import First Sheet Data into First Column, Second Sheet Data Into Second Column of Main Sheet using VBA

Excel VBA Macro To Merge First Sheet Data into First Column of  Main Sheet, Second Sheet Data In Second Column of Main Sheet and so on......

Sub ConsolNconcMulCol()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim W As Worksheet
Dim A As Integer
Dim B As Integer

A = 1 'Variable for Column Increment In Main Sheet

For Each W In Worksheets
If W.Name <> Sheets("MAIN").Name Then
W.Activate

For Y = 1 To 26
For X = 1 To 100

If Cells(X, Y) <> "" Then
Z = Z + 1 'Row Increment Variable
Sheets("MAIN").Cells(Z, A) = W.Cells(X, Y)
End If

Next X
Next Y

A = A + 1 'Variable for Column Increment In Main Sheet
End If

Z = 0
Next W

End Sub

Thanks, TAMATAM

Friday, September 21, 2012

How to Format Border Styles, Font Styles in Excel using VBA Macro

Excel VBA Macro To Change Border Styles
Sub BorderStyles()
'Style1: Selection.Borders.LineStyle = xlContinuous
'Style2: Selection.Borders.LineStyle = xlDouble
End Sub
'Macro To Change Font Styles
Sub FontFormats()
With Selection.Font
.Name = "Arial"
.Size = 12
.Italic = True
.ColorIndex = 10
.Bold = True
.Underline = True

End With
End Sub

Thanks,Tamatam

Thursday, September 20, 2012

Excel VBA Macro to Auto Fill a Specified Number of Times & Copy the Same

Excel VBA Macro to Auto Fill a Specified Number of Times & Copy the Same
Sub FillnCopy()
Dim x As Integer
Dim y As Integer
Dim z As Integer


On Error GoTo Err1:
y = InputBox("Enter The Desired No.of Times To Fill:")

For x = 1 To y - 1
z = z + 1
ActiveCell.Offset(z, 0) = ActiveCell.Value
Next x


Range(ActiveCell.Offset(z, 0), ActiveCell.Offset(z - (y - 1), 0)).Copy
Err1:
End Sub


Thanks,Tamatam

How to do Data Alignment using Excel VBA Macro

Excel VBA Macro for Data Alignment
Sub AlignCorrect()
Dim x As Integer
Dim y As Integer


For x = 2 To 500
For y = 1 To 26

Cells(x, y).Rows.RowHeight = 15
Cells(x, y).Columns.ColumnWidth = 15
Cells(x, y).VerticalAlignment = xlCenter
Cells(x, y).HorizontalAlignment = xlCenter


Next y
Next x
End Sub

Some Valid  Alignments:
Horizontal:
xlGeneral
xlLeft
xlRight
xlCenter

Vertical:
xlTop
xlBottom
xlCenter

Thanks,Tamatam

Friday, September 14, 2012

How to Adjust Rows Height and Columns Width using Excel VBA Macro

Excel VBA Macro To Adjust Rows Height and Columns Width
Method 1:
Sub AlignCorrect()
ActiveSheet.Rows.RowHeight = 15
ActiveSheet.Columns.ColumnWidth = 15

End Sub

Method 2:
Sub HeightWidth()
Dim x As Integer
Dim y As Integer


For x = 2 To 500
For y = 1 To 26

Cells(x, y).Rows.RowHeight = 15
Cells(x, y).Columns.ColumnWidth = 15
Next y
Next x

End Sub

Thanks,Tamatam

Thursday, September 13, 2012

How to Sort the Data using Excel VBA Macro

Excel VBA Macro to Sort the  Data Based on a Particular Column
Sub SortData()
Dim X As Integer
On Error GoTo Label

X = InputBox("Enter The SortBase Column:")
    Columns(X).Select
    
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.ADD Key:=Cells(1, X), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1:z1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Label:
End Sub

Thanks,Tamatam

How to Add Cell Contents in Comments Box with Excel VBA Macro

Excel VBA Macro To Add Cell Contents In Comment Box
The Following Macro is Designed to Perform a Requirement in Reporting.From the Following Macro you can pick a Piece of code you required.
Sub AddComments()
Dim X As Integer
Dim y As Integer
Dim z As Integer
Dim a As Integer
Dim TPR As String

Msg= MsgBox("Press OK to Conitnue else Press CANCEL to Exit", vbOKCancel, "Macro To Add Comments")

If Msg= vbCancel Then GoTo Handler:

For X = 2 To 1000 'Loop to Update Existing Data
For y = 7 To 10
Cells(X, y).ClearContents
Cells(X, y).ClearComments
Next y
Next X

z = 1
For X = 2 To 1000

If Cells(X, 5) = "Y" Then
z = z + 1 'Counting Variable
For y = 2 To 1000
If Cells(y, 1) <> "" And Cells(y, 1) = Cells(X, 1) And Cells(y, 5) = "Y" Then

Cells(z, 7) = Cells(y, 1)
Cells(z, 8) = Cells(z, 8) + Cells(y, 4) 'Sum here
Cells(z, 10) = Cells(z, 10) & Cells(y, 2) & " , " & Cells(y, 3) & "  -  "

End If
Next y
End If
Next X

'Loop to Add Cell Contents to Comment Box
For a = 2 To 1000  
Cells(a, 9).AddComment ("CompanyId,VersionId:" & Cells(a, 9) & Cells(a, 10))
Next a

For X = 1000 To 1 Step -1
For y = 1000 To 1 Step -1

If y <> X Then
If Cells(y, 7) <> "" And Cells(y, 7) = Cells(X, 7) Then
a = a + 1

If a > 2 Then  'Duplicates Count here
Cells(y, 7).Delete shift:=xlUp
Cells(y, 8).Delete shift:=xlUp
Cells(y, 9).Delete shift:=xlUp
Cells(y, 10).Delete shift:=xlUp
Application.ScreenUpdating = False  'Stops Screen Updation.
End If

End If
End If

Next y
Next X

MsgBox "Macro Process Completed"
Handler:
End Sub

Thanks,Tamatam

Macro To Combine or Merge or Consolidate Desired or Specific Sheets In One Sheet

Macro to Combine or Merge or Consolidate Specific desired Sheets In One Sheet
Sub ConsolDesireSheets()
Dim x As Integer
Dim y As Integer
Dim a As Worksheet
Dim b As Integer

b = 1 'Increment Variable

For Each a In Worksheets(Array("Sheet1", "Sheet3", "Sheet5"))
'Only Sheets defined in an Array are Consolidated in a given order following each
a.Activate
For x = 2 To 100 'Rows having the Data’
b = b + 1 'Data begins from 2 Row in a Consolidated Sheet’

For y = 1 To 6 'Columns having the Data’
Sheets ("MAIN").Cells (b, y) = a.Cells(x, y)
Next y

If Cells(x, 1) = "" Then Exit For
Next x
'b = b - 2  'Joins each Sheet data together, else each Sheet data is separated by a Single empty Row.
Next a
End Sub

Thanks,Tamatam

How to Combine or Merge or Consolidate All Sheets Into One Sheet with VBA Macro

Excel VBA Macro To Combine or Merge or Consolidate All Sheets Into One Sheet
Sub ConsolAllSheets()
Dim x As Integer
Dim y As Integer
Dim a As Worksheet
Dim b As Integer

b = 1 'Increment Variable

For Each a In Worksheets
a.Activate

If a.Name <> Sheets("MAIN").Name Then
'Upto Main Sheet where we consolidate data, and the Main Sheet will now include in Consolidated sheets.
For x = 2 To 100 'Rows having the Data.
b = b + 1 'Data row begins from 2 Row in Consolidated Sheet.

For y = 1 To 6 'Columns having the data.
Sheets("MAIN").Cells(b, y) = a.Cells(x, y)
Next y

If Cells(x, 2) = "" Then Exit For
Next x
'b = b - 2 'Joins each Sheet data together, else each Sheet data is separated by a single empty Row.
End If

Next a
End Sub

Thanks,Tamatam

Monday, September 10, 2012

Excel VBA Macro to Segregate Data From One Sheet To Many

Excel VBA Macro for Segregating Data From One Sheet To Many
Sub Data_Seg()
Dim X As Integer
Dim y As Integer
Dim z As Integer
Dim a As Integer
Dim b As Integer
Dim C As Integer

a = 1

For X = 2 To 100
If Sheets("sheet2").Cells(X, 8) <> "" Then
Sheets.ADD.Name = Sheets("Sheet2").Cells(X, 8)
'Cells(x,8)having the names on which we create the Sheets'

For z = 2 To 100
If InStr(LCase(Sheets("sheet2").Cells(z, 1)), LCase(Sheets("sheet2").Cells(X, 8))) Then
a = a + 1

For b = 1 To 6 ' Cell having the data to segregate'
ActiveSheet.Cells(a, b) = Sheets("sheet2").Cells(z, b)
ActiveSheet.Cells(1, b) = Sheets("sheet2").Cells(1, b)
ActiveSheet.Cells(1, b).Font.Bold = True
Next b

End If
Next z

For C = 2 To 100
If ActiveSheet.Cells(C, 4) <> "" Then
ActiveSheet.Cells(2, 5) = C - 1
ActiveSheet.Cells(2, 6) = ActiveSheet.Cells(2, 6) + ActiveSheet.Cells(C, 4)
End If
Next C

End If
a = 1   ‘To make in every sheet data beginning from first row’
Next X
End Sub

Thanks,Tamatam

Excel VBA Macro to Insert a Blank Row between Individual Data Items

Excel VBA Macro to insert a entire row between individual data items based on first column
'We should sort the data before run a macro to insert blank row'
Sub Insert_Blank_Row()
Dim X As Integer
Dim Y As Integer
Dim z As Integer
Dim a As String

For X = 2 To 100

If Cells(X, 1) <> "" And Cells(X, 1) <> Cells(X + 1, 1) Then
Cells(X, 1).Offset(1, 0).EntireRow.Insert
End If

Next X
End Sub

Thanks,Tamatam

Macro To Sum Of Values Of Desired Column And Display The Results In a Desired Cell


Macro to Sum the Values of a Desired Column and Display The Results In a Desired Cell
Sub SUM_Column()
Dim X As Integer
Dim Y As Integer
Dim z As Integer
Dim a As String

On Error GoTo Label:

z = InputBox("Enter Desired Col. No. To Find Sum ", "Find Sum ", "Enter Here")

a = InputBox("Enter Range Reference to Display Count Results", _
"Where to Disply Sum Results ", "Enter Here As A1 or B12.....")

For X = 2 To 100

If Cells(X, z) <> "" Then
Range(a) = Range(a) + Cells(X, z)
End If

Next X
Label:
End Sub

Thanks,Tamatam

Macro To Count No.of Non Empty Cells In a Desired Column and Display the Results In a Desired Cell


Macro To Count the No.of Non Empty Cells In Desired Column and Display the Results In a Desired Cell
Sub Count_Non_Empty()
Dim X As Integer
Dim Y As Integer
Dim z As Integer
Dim a As String

On Error GoTo Label:

z = InputBox("Enter Desired Col. No. To Find Count of  Non Empty Cells", "Find Count", "Enter Here")

a = InputBox("Enter Range Reference to Display Count Results", _
"Where to Disply Count Results ", "Enter Here As A1 or B12.....")

For X = 1 To 100
If Cells(X, z) <> "" Then
 Y = Y + 1
Range(a) = Y
End If

Next X
Label:
End Sub

Thanks,Tamatam

How to Fill 56 Colors In First Column of a Sheet using VBA Macro

VBA Macro To Fill 56 Colors In First Column Of A Sheet
'Break The Loop when x=10
Sub AddColor()
Dim X As Integer
For X = 1 To 56
ActiveSheet.Cells(X, 1).Interior.ColorIndex = X
If X = 10 Then Exit For     'Loop Breaks Here
Next X
End Sub

Thanks,Tamatam

Saturday, September 1, 2012

How to extract the Strings which exactly Match with the Desired String in Excel with VBA Macro


VBA Macro To Pull Out Strings Exactly Match with the Desired String in Excel
Sub Serch_Extract()
Dim x As Integer
Dim Y As Integer
Dim Z As Integer
Dim b As Integer
Dim a As String
Dim d As String

b = 1
On Error GoTo Label:
d = InputBox("Enter Your Name: ")
a = InputBox("Hai" & " " & d & " " & "Enter Your Search Sring :")
Y = InputBox("Enter Search Colno :")
Z = InputBox("Enter Search Results Colno :")
Cells(1, Z) = " SEARCH RESULTS"
Cells(1, Z).Font.Bold = True

For x = 1 To 100
If Mid(LCase(Cells(x, Y)), 1, Len(a)) = LCase(a) And Len(LCase(Cells(x, Y))) = Len(a) Then
b = b + 1
Cells(b, Z) = Cells(x, Y)
End If
Next x

Label:
End Sub

Thanks,Tamatam

Featured Post from this Blog

How to compare Current Snapshot Data with Previous Snapshot in Power BI

How to Dynamically compare two Snapshots Data in Power BI Scenario: Suppose, we have a sample Sales data, which is stored with Monthly Snaps...

Popular Posts from this Blog