Tuesday, October 2, 2012

How To Segregate Data by Region and Export Each Region Data to a New Work Book using Excel VBA Macro

Excel VBA Macro To Segregate Data by Region and Export To New Work Books
'Example :- Suppose there is a Workbook Called "MyBook" in which there is a sheet called "MyData" .
'The sheet "MyData" contains data of Different Regions with respective Countries , Products, Sales.
'Let us consider all Regions are Mentioned In the First Column of a sheet,then
'The Following Macro Exports All Data of each Region to New Workbook by the Current Region Name.

Sub ExportSegData()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim A As Integer
Dim C As Integer
Dim D As Integer

Dim F As String
Dim P As String
Dim B As String
Dim I As String
Dim J As String
Dim S As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Visible = False

On Error Resume Next

Z = 0
D = 0

P = "C:\Documents and Settings\Administrator\My Documents\" 'Export To This Path
I = InputBox("Enter Current WorkBook Name  ", "Workbook From Which Data To Be Segregate", "Enter Here...")
'Current WorkBook Name From Which Data To Be Segregate
J = InputBox("Enter Data Sheet Name In Current WorkBook ", "Worksheet From Which Data To Be Segregate", "Enter Here...")
'Current Data Sheet Name From Which Data To Be Segregate

F = Workbooks(I).Name
B = Workbooks(I).Sheets(J).Name

MkDir P & F

For X = 2 To 1000

If Workbooks(I).Sheets(J).Cells(X, 1) = "" Then Exit For
If Workbooks(I).Sheets(J).Cells(X, 1) <> Workbooks(I).Sheets(J).Cells(X + 1, 1) Then

S = Workbooks(I).Sheets(J).Cells(X, 1)

Workbooks.ADD.SaveAs (P & F & "\" & S & ".xlsx")
'Adds A New Workbook To Export Data
Workbooks(S).Sheets(1).Name = S

For A = 1 To 26    'Columns Having The Data
For Y = 2 To 100  'Rows Having The Data

If InStr(LCase(Workbooks(I).Sheets(J).Cells(Y, 1)), LCase(S)) Then
Z = Z + 1
ActiveWorkbook.Sheets(S).Cells(Z, A) = Workbooks(I).Sheets(J).Cells(Y, A)
ActiveWorkbook.Sheets(S).Cells(1, A) = Workbooks(I).Sheets(J).Cells(1, A)
ActiveWorkbook.Sheets(S).Cells(1, A).Font.Bold = True
End If

Next Y
Z = 1
Next A

For C = 2 To 100

If ActiveWorkbook.Sheets(S).Cells(C, 4) <> "" Then
D = D + 1
ActiveWorkbook.Sheets(S).Cells(2, 5) = D  'To Find Count
ActiveWorkbook.Sheets(S).Cells(2, 6) = _
ActiveWorkbook.Sheets(S).Cells(2, 6) + ActiveWorkbook.Sheets(S).Cells(C, 4)
'To Find Sum
End If

Next C

Workbooks(S).Save
Workbooks(S).Close

End If

Z = 1
D = 0

Next X

MsgBox "Macro Process Completed"
Application.Visible = True
End Sub

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

No comments:

Post a Comment

Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.

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