PDA

View Full Version : Split the files based on the Specific Column and update the Row Count



bvsramesh
04-20-2012, 04:48 AM
Hi,

I have created a macro to split the files based on a specific column (D) and it is running correctly.

I need little more while splitting the files an excel sheet should be update like how many rows the file is splitting on which name. (for example the Column (D) contains the name "Surya" for 6 Rows, while splitting the files in the new excel sheet it should update "Suya" "6 Rows"

i am here with attaching the file and the macro and my requiremnt in the excel sheet.


Public Sub SplitToFiles_Dept_Tag_LL()
' MACRO Split The Files Based on Cell Value in Specific Column
' Last update: 23-03-2012
' Author: BVS.RAMESH
Dim osh As Worksheet ' Original sheet
Dim iRow As Long ' Cursors
Dim iCol As Long
Dim iFirstRow As Long ' Constant
Dim iTotalRows As Long ' Constant
Dim iStartRow As Long ' Section delimiters
Dim iStopRow As Long
Dim sSectionName As String ' Section name (and filename)
Dim rCell As Range ' current cell
Dim owb As Workbook ' Original workbook
Dim sFilePath As String ' Constant
Dim iCount As Integer ' # of documents created
'Dept_Tag_Validation
iCol = 4
iRow = 2
With ActiveWorkbook.Sheets("Dept_Tag_Validation_LL").Select
Cells.Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'iCol = Application.InputBox("Enter the column number used for splitting", "Select column", 2, , , , , 1)
'iRow = Application.InputBox("Enter the starting row number (to skip header)", "Select row", 5, , , , , 1)
iFirstRow = iRow
'Set osh = Application.ActiveSheet
Set osh = Sheet5
Set owb = Application.ActiveWorkbook
iTotalRows = osh.UsedRange.Rows.Count
sFilePath = Application.ActiveWorkbook.Path
If Dir(sFilePath + "\Split", vbDirectory) = "" Then
MkDir sFilePath + "\Low Level Owners"
End If
'Turn Off Screen Updating Events
Application.EnableEvents = False
Application.ScreenUpdating = False
Do
' Get cell at cursor
Set rCell = osh.Cells(iRow, iCol)
sCell = Replace(rCell.Text, " ", "")
If sCell = "" Or (rCell.Text = sSectionName And iStartRow <> 0) Or InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Then
' Skip condition met
Else
' Found new section
If iStartRow = 0 Then
' StartRow delimiter not set, meaning beginning a new section
sSectionName = rCell.Text
iStartRow = iRow
Else
' StartRow delimiter set, meaning we reached the end of a section
iStopRow = iRow - 1
' Pass variables to a separate sub to create and save the new worksheet
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1
' Reset section delimiters
iStartRow = 0
iStopRow = 0
' Ready to continue loop
iRow = iRow - 1
End If
End If
' Continue until last row is reached
If iRow < iTotalRows Then
iRow = iRow + 1
Else
' Finished. Save the last section
iStopRow = iRow
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1
' Exit
Exit Do
End If
Loop
'Turn On Screen Updating Events
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox Str(iCount) + " documents saved in " + sFilePath

End Sub
Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)
Dim rngRange As Range
Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow
rngRange.Select
rngRange.Delete
End Sub

Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)
Dim ash As Worksheet ' Copied sheet
Dim awb As Workbook ' New workbook
' Copy book
osh.Copy
Set ash = Application.ActiveSheet
' Delete Rows after section
If iTotalRows > iStopRow Then
DeleteRows ash, iStopRow + 1, iTotalRows
End If
' Delete Rows before section
If iStartRow > iFirstRow Then
DeleteRows ash, iFirstRow, iStartRow - 1
End If
' Select left-topmost cell
ash.Cells(1, 1).Select
' Clean up a few characters to prevent invalid filename
sSectionName = Replace(sSectionName, "/", " ")
sSectionName = Replace(sSectionName, "\", " ")
sSectionName = Replace(sSectionName, ":", " ")
sSectionName = Replace(sSectionName, "=", " ")
sSectionName = Replace(sSectionName, "*", " ")
sSectionName = Replace(sSectionName, ".", " ")
sSectionName = Replace(sSectionName, "?", " ")
' Save in same format as original workbook
ash.SaveAs sFilePath + "\Low Level Owners\" + sSectionName, fileFormat
' Close
Set awb = ash.Parent
awb.Close SaveChanges:=False
End Sub


please check and give the update..

thanks in advance.

Regards,

Surya

bvsramesh
04-21-2012, 01:16 AM
Hi team, please help me on the above code.

Regards,
BVSR

bvsramesh
04-24-2012, 01:33 AM
Hi Team,

So far nobody from our team was not able to respond as i am in urgent need. plz as this requirement is Quality check if this is done then only my project will go forward. So plz help me...

Regards,

BVSR

BrianMH
04-24-2012, 01:45 AM
Your code references sheets that do not exist. Can you explain what exactly your macro is doing and what exactly you want it to do. Unfortunately I don't have time to read all your code to define what it is doing so if you could explain what specifically you want it to do then we can help.

bvsramesh
04-24-2012, 02:14 AM
Hi,

Apologies for my mistake, I just have updated my code in the sheet plz check (as i have attached a module to the sheet).

I just need that when the original file is splitting a new sheet to be update with the names on which the file is splitting and how many rows it is splitting.

for example : if we run the macro there are 6 files are in the new folder (Low Level Owners) splitting based on the column "D" (Low Level Owner).

if you take one of the file "Adeline Lim" thre are two rows (other than the header) i need the count like this and this count should be updated in the new sheet (My Requirement). plz find the attached in "My Requirement" sheet.

Regards,

BVSR

BrianMH
04-24-2012, 02:32 AM
Would it not be easier just to use a countif formula based on the data you are splitting?

IE on your "my requirement" sheet in B2 the formula would be =COUNTIF(Dept_Tag_Validation_LL!D:D,'My Requirement'!A2)

bvsramesh
04-24-2012, 03:31 AM
Hi Team,

This not actually to count the number of rows on which name this to check whether all the rows on the particular name has taken or not to check its kind of quality check in the macro.

This shoud be done only when the time of splitting the file it self. So plz try to give a possible solution.

Regards,

BVSR