Sunday, 31 March 2013

How to Export or Save Each Sheet as Tab Delimited Text File

Excel VBA Macro To Export or Save Each Sheet as Tab Delimited Text File With Back Up
'This Macro Creates a Folder With Workbook Name & Date Stamp and Saves Each Worksheet as a TabDelimited Text File and Keep a Copy of Excel Sheet as Back up In Target Folder
Sub Export_Each_Sheet_As_TabDelimited_TextFile()
Dim WS As Worksheet
Dim MyStr1 As String
Dim MyStr2 As String
Dim MyPath As String
Dim SavePath As String
Dim MyDate
Dim MyTime

MyDate = Date    ' MyDate Returns the current system date.

MyTime = Time    ' Returns current system time.

Application.DisplayAlerts = False

Application.ScreenUpdating = False
On Error Resume Next

MyStr1 = Format(MyDate, "DD-MM-YYYY")

'Use MyStr2 If You Require Time Stamp In File Name
'MyStr2 = Format(MyTime, "HH.MM.SS")
MyPath = "C:\Documents and Settings\Administrator\My Documents\"
MkDir MyPath & MyStr1 & "_" & ThisWorkbook.Name
SavePath = MyPath & MyStr1 & "_" & ThisWorkbook.Name & "\"

For Each WS In ThisWorkbook.Sheets

WS.Activate
ActiveSheet.Copy
'Exporting Sheet as Tab Delimited Text File To Target Path
ActiveSheet.SaveAs Filename:=SavePath & WS.Name, FileFormat:=xlTextWindows
'Saving a Backup Copy of a Sheet in Target Path
ActiveSheet.SaveAs Filename:=SavePath & WS.Name, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close Savechanges:=True
Next WS
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ThisWorkbook.Activate
'ThisWorkbook.Close Savechanges:=True
'Application.Quit
End Sub

Thanks.,
TAMATAM
  Reporting Analyst

Tuesday, 26 March 2013

How to Remove Duplicates from Multiple Columns using Excel VBA Macro

Excel Macro To Remove Duplicates from Each Column In a Active Sheet
Sub Remove_Dups_In_All_Columns()
Dim X As Integer
Dim Y As Integer
Dim CC As Long
Dim DC As Integer

DC = 0

CC = ActiveSheet.Columns.count

For X = 1 To CC 'Count of All Columns In Active Sheet
If Cells(1, X) = "" Then Exit For
DC = DC + 1 'Data Columns Count In Active Sheet
Next X

For Y = 1 To DC

ActiveSheet.Cells(1, Y).EntireColumn.Select
Selection.RemoveDuplicates Columns:=1, Header:=xlYes
Next Y

End Sub


Thanks,

TAMATAM



How to Combine or Merge or Consolidate Data From Multiple Columns Into a Dynamic Column and Remove Duplicates

Excel VBA Macro To Combine or Merge or Consolidate Data From Multiple Columns into a Dynamic Column and Remove Duplicates
This is a very user friendly macro that Search for a Dynamic Column and Consolidate the data from multiple columns into a Dynamic Column and shows the Unique data in the Next Column.


Sub Consol_Get_Unique()
Dim I As Integer
Dim J As Integer

Dim TC As Long

Dim Col_Search As String

Dim TargetColumn As Range

Col_Search = "Consol_Data" 'Dynamic Column Name In Which We Consolidate Data


Set TargetColumn = ActiveSheet.Rows(1).Find(What:=Col_Search, LookIn:=xlValues, _

    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

If Not TargetColumn Is Nothing Then

        MsgBox "Target Column Found At  " & TargetColumn.Address & _
        " and the Targe Column Number is " & TargetColumn.Column
Else:
MsgBox "TargetColumn Not Found"
End If

TC = TargetColumn.Column

Uniq_Data = TC + 1 'Unique Data Column Is Next To Consol Data Column

Z = 1 'Counting Variable

For I = 1 To 4 'Columns having data
For J = 2 To 100 'Rows having data
If Cells(J, I) = "" Then Exit For
Z = Z + 1
Cells(Z, TC) = Cells(J, I) 'Dynamic Column In Which We Consoldate Data
Next J
Next I

ActiveSheet.Columns(TC).Select

Selection.Copy
ActiveSheet.Columns(Uniq_Data).Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes
ActiveSheet.Cells(1, Uniq_Data) = "Unique_Data"
Application.CutCopyMode = False

End 


Thanks.,
Tamatam

How To Search in a Dynamic Column in Excel

Excel VBA Macro To Find a Dynamic Column Name
Sub Dynamic_Column_Search()
Dim Col_Search As String
Dim TargetColumn As Range

Col_Search = "Consol_Data" 'Dynamic Column Name That you want Search or Find

Set TargetColumn = ActiveSheet.Rows(1).Find(What:=Col_Search, LookIn:=xlValues, _

    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

If Not TargetColumn Is Nothing Then

        MsgBox "Target Column Found At  " & TargetColumn.Address & _
        " and the Targe Column Number is " & TargetColumn.Column
Else:
MsgBox "TargetColumn Not Found"
End If
End Sub

Saturday, 23 March 2013

How To Cobine or Merge or Consolidate or Import or Export Data From Multiple Workbooks Into One Sheet

Excel VBA Macro To Cobine or Merge or Consolidate or Import or Export Data from All Sheets of  Multiple Workbooks Into Single Sheet of Another New Workbook

Sub Consol_All_Books2OneSheet()

Dim LastDataRow As Long
Dim LastDataColumn As Long
Dim MyDataRange As Object
Dim WS As Worksheet
Dim DataSource As String

On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next

Export2File = Format(Now(), " DD_MM_YYYY HH-MM AMPM ")


'Target File location into which files are to be Merge.....Change as you wish.......

Workbooks.Add(xlWBATWorksheet).SaveAs FileName:="D:\MBA\" & Export2File & ".xlsm ", FileFormat:=52
'FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
Set TargetFile = ActiveWorkbook
ActiveWorkbook.Sheets(1).Name = "Consolidate"

'Source File location from which files are to be Export.....Change as you wish.......

SourcePath = "C:\Documents and Settings\Administrator\My Documents\"
SrcFileName = Dir(SourcePath & "*.xls*")
    
Do While SrcFileName <> ""
Set SourceFile = Workbooks.Open(FolderPath & SrcFileName)
For Each WS In SourceFile.Sheets
WS.Activate

DataSource = "Source: [" & "Workbook Name:" & " " & ActiveWorkbook.Name & " " & _

"|" & "Sheet Name:" & " " & WS.Name & "|" & "Path :" & " " & ThisWorkbook.Path & "]"

LastDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious).Row

LastDataColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column

Set MyDataRange = ActiveSheet.Range(Cells(1, 1).Offset(LastDataRow, 0), Cells(1, 1).Offset(0, LastDataColumn))

MyDataRange.Copy

TargetFile.Sheets("Consolidate").Activate

TargetDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

If TargetDataRow = "" Then

Cells(2, 1).Select
ActiveSheet.Paste
Cells(1, 1).Value = DataSource
Cells(1, 1).Font.Bold = True
Else:
Cells(TargetDataRow, 1).Offset(3, 0).Select
ActiveSheet.Paste
Cells(TargetDataRow, 1).Offset(2, 0).Value = DataSource
Cells(TargetDataRow, 1).Offset(2, 0).Font.Bold = True
End If

Next WS

SourceFile.Activate
ActiveWorkbook.Close SaveChanges:=False
    
SrcFileName = Dir() 'Allows to Go to Next File in a Directory
Loop

TargetFile.Close SaveChanges:=True

    
Application.EnableEvents = True
Application.DisplayAlerts = True
    
MsgBox "All Wokbooks with All Sheets Successfllly Exported To Target File Sheet", vbInformation, "Successfully Exported !"
End Sub


Thanks.,

Tamatam

How to Combine or Consolidate or Merge All Sheets Data Into One Sheet

Excel VBA Macro To Combine or Merge or Consolidate All Sheets Data into One Sheet
'This is a very use full and User-friendly Macro which Copies the Active Data Range from Each sheet Into One Sheet[Consolidate].

Sub Consol_Sheets()
Dim LastDataRow As Long
Dim LastDataColumn As Long
Dim MyDataRange As Object
Dim WS As Worksheet
Dim DataSource As String

On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

For Each WS In ThisWorkbook.Sheets

If WS.Name <> Sheets("Consolidate").Name Then
WS.Activate

DataSource = "Source: [" & "Workbook Name:" & " " & ActiveWorkbook.Name & " " & _

"|" & "Sheet Name:" & " " & WS.Name & "|" & "Path :" & " " & ThisWorkbook.Path & "]"

LastDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious).Row

LastDataColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column

Set MyDataRange = ActiveSheet.Range(Cells(1, 1).Offset(LastDataRow, 0), Cells(1, 1).Offset(0, LastDataColumn))


MyDataRange.Copy

ThisWorkbook.Sheets("Consolidate").Activate

TargetDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

If TargetDataRow = "" Then Cells(2, 1).Select

ActiveSheet.Paste
Cells(1, 1).Value = DataSource
Cells(1, 1).Font.Bold = True
Else
Cells(TargetDataRow, 1).Offset(3, 0).Select
ActiveSheet.Paste
Cells(TargetDataRow, 1).Offset(2, 0).Value = DataSource
Cells(TargetDataRow, 1).Offset(2, 0).Font.Bold = True
End If

End If

Next WS

End Sub


Note:

We can perform the same task purely using Loops.To know that method please go through following link...
Consolidate All Sheets Data Into One Sheet Using Loops



Thanks.,

Tamatam

Macro To Know Active Work Book Path and Full Name

How To Know Active Work Book Path and Full Name 
Sub WorkBook_Details()
ActivWorkbookPath = ActiveWorkbook.Path
ActiveWorkBookName = ActiveWorkbook.Name
ActWorkBookFullName = Application.ActiveWorkbook.FullName

MsgBox "ActiveWorkBookName = " & ActiveWorkBookName & vbCrLf & _
"ActivWorkbookPath = " & ActiveWorkbook.Path & vbCrLf & _
"ActWorkBookFullName =" & Application.ActiveWorkbook.FullName, vbInformation, "Work Book Details"

End Sub

Thanks.,
Tamatam

Friday, 22 March 2013

How To Add a Workbook with Single Sheet

Excel VBA Macro To Add a Workbook with Single Sheet
Sub WbkWithSingleSheet()
Workbooks.Add(xlWBATWorksheet).SaveAs _
FileName:="C:\Documents and Settings\Administrator\My Documents\Sample", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

'You can change your File Path which is colored above.
Thanks
Tamatam

How To Consolidate or Merge or Import Multiple Workbooks into One Workbook with Excel VBA Macro

Excel VBA Macro To Import or Export Multiple Workbooks into One Workbook
Excel VBA Macro To Merge Multiple Workbooks with Multiple Sheets into One Workbook
'This is a very user friendly macro that allows you Merge all work sheets of multiple workbooks from a folder/location in to a Newly created Workbook in other location.

Sub MergeAllWorkbooks()


    Dim SourcePath As String
    Dim SrcFileName As String
    
    Dim SourceFile As Workbook
    Dim TargetFile As Workbook
    Dim WS As Worksheet
   
    Dim SheetIndex As Integer
    Dim Export2File As String
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    SheetIndex = 1    
    Export2File = Format(Now(), " DD_MM_YYYY HH-MM AMPM ")

Target File location in to which files are to be Merge.....Change as you wish.......
    Workbooks.Add.SaveAs FileName:="D:\TPR\Merge\" & Export2File & ".xlsm ", FileFormat:=52
    'FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Set TargetFile = ActiveWorkbook
    
'Path From which Files are to be Merge........Change as you wish........
    SourcePath = "C:\Documents and Settings\Administrator\My Documents\"
    SrcFileName = Dir(SourcePath & "*.xls*")
    
    Do While SrcFileName <> ""
        Set SourceFile = Workbooks.Open(FolderPath & SrcFileName)
           
            For Each WS In SourceFile.Sheets 'Loop Through Each Worksheet
                WS.Copy Before:=TargetFile.Sheets(SheetIndex)
                SheetIndex = SheetIndex + 1
            Next WS
      
        SourceFile.Activate
        ActiveWorkbook.Close SaveChanges:=False
    
     SrcFileName = Dir() 'Allows to Go to Next File in a Directory
    Loop

    TargetFile.Close SaveChanges:=True

    
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    MsgBox "All Wokbooks with All Sheets Successfllly Exported To Target File"
       
End Sub


>>>>>>>>><<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>><<<<<<<<>>>>>>>>>><<<<<<<>>>>

<<< Keep on Following My Blog >>>

<<< Excel your Skills in Excel VBA Macros >>>
-------------------------------------------------------------------------------        
 Thanks
 Tamatam

>>>>>>>>><<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>><<<<<<<<>>>>>>>>>>

Excel VBA Macro Save a Excel Workbook As Macro Enabled

How to Save a Excel Workbook as Macro Enabled

Sub SaveAsMacroEnable()

Workbooks.Add.SaveAs FileName:="D:\MBA\Merge\" & Export2File & ".xlsm ", FileFormat:=52

'FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub






  ---------------------------------------------------------------------------------->
<<< Keep on Following My Blog >>>

<<< Excel your Skills in Excel VBA Macros >>>
     ---------------------------------------------------------------------------------->         
 Thanks
 Tamatam

Wednesday, 20 March 2013

How to Find Current Region, Used Range, Last Row and Last Column in Excel with VBA Macro

Excel VBA Macros to Know Current Region , Used Range , Last Row , Last Column and Last Cell 
------------------------------------------------------------------------------------
Macro To Select Current Region:
Sub CurrentRegion()
ActiveSheet.Range("a1").Select
ActiveCell.CurrentRegion.Select
End Sub
< or >
Sub Current_Region()
ActiveSheet.Cells.CurrentRegion.Select
End Sub


Note:
This Macro only selects current region where there is continuity in the range and ignores the remaining data in the sheet.
------------------------------------------------------------------------------------
Macro To Know Used Range In a ActiveSheet :
Model-1:
Sub UsedRange()
LastUsedRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

LastUsedColumn = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column

' Last Row and Column based on Particular Column or Row :

' LastRow = Cells(Cells.Rows.Count,"A").End(xlUp).Row
' LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

' LastColumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column


' LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

MsgBox "You Have Used " & LastUsedRow & " Rows " & vbCrLf & _

" and " & LastUsedColumn & " Columns In This Worksheet"
End Sub

Model-II :
Sub Used_Rows_Columns_Range()
Dim RC As Long
Dim CC As Long
Dim Sort_Range As String

'To Get Column Index Number in Used Range(Eg: 1,2,3)
RC = ActiveSheet.UsedRange.Rows.Count
CC = ActiveSheet.UsedRange.Columns.Count

MsgBox RC

MsgBox CC

' To Get Column Index Name in Used Range(Eg: A,B,C..)


CN = Split(Cells(, CC).Address, "$")(1)



Data_Range = "$A$2" & " : " & "$" & CN & "$" & RC


MsgBox Data_Range 

ActiveSheet.Range(Data_Range).Select
Selection.Copy
'To select the Last cell in the UsedRange
ActiveCell.SpecialCells(xlLastCell).Select


End Sub



Note:
This Macro show entire range or region that you have used in the past or  present in the active sheet even you may erases some cells data , they also comes under used range. 
------------------------------------------------------------------------------------
Macro To Select Last Used Cell In a Column Range

Sub LastUsed_Column_Cell()
ActiveSheet.Range("A1").End(xlDown).Select


ActiveSheet.Range("A10000").End(xlUp).Select



End Sub

Note:
This Macro only selects current region in the column where there is continuity in the column range and ignores the remaining data in the column as shown in the above.


Other References for Dynamic Used Range :

How to Select Dynamic Actual Used Range in Excel


Thanks.,
Tamatam


How To Find Last Used Row and Column in a Worksheet

Excel VBA Macro To Find Last Used Row and Column in a Worksheet
Sub LastRow_UsedInSheet()

MyLastRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious).Row

MyLastColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column

MsgBox MyLastRow & " Rows Have Used In ActiveSheet " & vbCrLf & _

MyLastColumn & " Columns Have Used In ActiveSheet "

End Sub


Example :

Note:
This method will find only the Used Rows and Columns with data.
We can use this Count while Consolidating the data from the Several Sheets into One Sheet.

Thanks,
TAMATAM

Tuesday, 19 March 2013

Excel AverageIF and AverageIFs Functions Syntax and Examples

Excel AverageIF and AverageIFs Functions
AVERAGEIF Function:
Returns the average (arithmetic mean) of all the cells in a range that meet a given criteria.

Syntax

=AVERAGEIF(range,criteria,average_range)

Range  is one or more cells to average, including numbers or names, arrays, or references that contain numbers.


Criteria  is the criteria in the form of a number, expression, cell reference, or text that defines which cells are averaged. For example, criteria can be expressed as 143, "143", ">123", "Car", "=*West","<>South", or B4. 


Average_range  is the actual set of cells to average. If omitted, range is used.


Remarks:

Cells in range that contain TRUE or FALSE are ignored. 
  • If a cell in average_range is an empty cell, AVERAGEIF ignores it.
  • If range is a blank or text value, AVERAGEIF returns the #DIV0! error value.
  • If a cell in criteria is empty, AVERAGEIF treats it as a 0 value.
  • If no cells in the range meet the criteria, AVERAGEIF returns the #DIV/0! error 
Average_range does not have to be the same size and shape as range. The actual cells that are averaged are determined by using the top, left cell in average_range as the beginning cell, and then including cells that correspond in size and shape to range.


Examples:
Suppose we have the Sales Data as follows :

Prod
Sal_Region
Sal_Month
Net Sales
MotorCycle
East
Mar
521
Jeep
West
Jun
640
Car
North
Aug
386
MotorCycle
South
Mar
103
Jeep
East
Feb
327
Autocar
North
Jul
809
ByCycle
West
Sep
559
MotorCycle
East
Mar
870
Auto
South
Jan
769


AverageIf based on various Criteria as follows :
AverageIF Formula
Result
  =AVERAGEIF(A1:A10,"MotorCycle",D1:D10)
498.00
 =AVERAGEIF(A1:A10,"<>MotorCycle",D1:D10)
581.67
 =AVERAGEIF(A1:A10,"*Cycle",D1:D10)
513.25
 =AVERAGEIF(A1:A10,"Auto*",D1:D10)
789.00

---------------------------------------------------------------------------------------------------------------------
AVERAGEIFs Function:
Returns the average (arithmetic mean) of all cells that meet multiple criteria.

Syntax
=AVERAGEIFS(average_range,criteria_range1,criteria1,criteria_range2,criteria2…)

Average_range   is one or more cells to average, including numbers or names, arrays, or references that contain numbers.

Criteria_range1, criteria_range2, …   are 1 to 127 ranges in which to evaluate the associated criteria.

Criteria1, criteria2, …   are 1 to 127 criteria in the form of a number, expression, cell reference, or text that define which cells will be averaged. For example, criteria can be expressed as 32, "32", ">32", "Car", or B4.

Remarks:
  • If average_range is a blank or text value, AVERAGEIFS returns the #DIV0! error value.
  • If a cell in a criteria range is empty, AVERAGEIFS treats it as a 0 value.
  • Cells in range that contain TRUE evaluate as 1; cells in range that contain FALSE evaluate as 0 (zero). 
  • Each cell in average_range is used in the average calculation only if all of the corresponding criteria specified are true for that cell.
  • Unlike the range and criteria arguments in the AVERAGEIF function, in AVERAGEIFS each criteria_range must be the same size and shape as sum_range. 
  • If cells in average_range cannot be translated into numbers, AVERAGEIFS returns the #DIV0! error value. 
  • If there are no cells that meet all the criteria, AVERAGEIFS returns the #DIV/0! error value.
  • You can use the wildcard characters, question mark (?) and asterisk (*), in criteria. A question mark matches any single character; an asterisk matches any sequence of characters. If you want to find an actual question mark or asterisk, type a tilde (~) before the character.

Examples :
Suppose we have the Sales Data as follows :
Prod
Sal_Region
Sal_Month
Net Sales
MotorCycle
East
Mar
521
Jeep
West
Jun
640
Car
North
Aug
386
MotorCycle
South
Mar
103
Jeep
East
Feb
327
Autocar
North
Jul
809
ByCycle
West
Sep
559
MotorCycle
East
Mar
870
Auto
South
Jan
769

AverageIfs based on various Criteria as follows :
AverageIFs Formula
Result
 =AVERAGEIFS(D1:D10,A1:A10,"MotorCycle",C1:C10,"Mar")
695.50
 =AVERAGEIFS(D1:D10,A1:A10,"*Cycle",C1:C10,"<>Mar")
331.00


Thanks,
TAMATAM

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts