sort and create new sheets from CSV data

Here is me --> :banghead:
I can't Figure out :dunno a simple VB Function...

I am trying to sort a CSV file and create sheets from it
|A |B |C |D |E
DateTimeUser-NameGroup-NameReal Name

I need to sort the file on "Group-Name" then create several sheets all named
as the groups located in the CSV File (there are about 20 group names but thousands of instances) then extract the "User-Names" assosiated to the group
an insert the thousands of names in to the sheet.

Ok Maybe not so Simple :doh: I attached sample below

Hello,

Give the following a try, it will prompt you for the .csv file at runtime. If you have any questions or wish to make any modifications, don't hesitate to ask!

Code:

---

Sub Amnicbra()
    Dim vArr() As String, vGroupNames() As String, vGNCnt As Long
    Dim i As Long, j As Long, c As Long, r As Long, iUB As Long, jUB As Long
    Dim vFile As String
    vFile = Application.GetOpenFilename("CSV Files,*.csv,Text Files,*.txt,All Files,*.*")
    If LCase(vFile) = "false" Then Exit Sub
    vArr = TextFileToStringArray("c:\pipe.txt", ",")
    vGNCnt = 0
    iUB = UBound(vArr, 1)
    jUB = UBound(vArr, 2)
    ' Workbooks.Add 1
    ' ActiveSheet.Name = "All data"
    ' Range("A1").Resize(iUB + 1, jUB + 1) = vArr
    ReDim vGroupNames(0)
    For i = 0 To iUB
        If InSArr(vGroupNames, vArr(i, 3)) = -1 Then
          ReDim Preserve vGroupNames(vGNCnt)
            vGroupNames(vGNCnt) = vArr(i, 3)
            vGNCnt = vGNCnt + 1
        End If
    Next 'i
    vGNCnt = vGNCnt - 1
    Application.ScreenUpdating = False
    For j = 0 To vGNCnt
        Sheets.Add
        r = 1
        For i = 0 To iUB
            If vArr(i, 3) = vGroupNames(j) Then
                For c = 1 To jUB + 1
                    Cells(r, c) = vArr(i, c - 1)
                Next 'c
                r = r + 1
            End If
        Next 'i
    Next 'j
    Application.ScreenUpdating = True
End Sub

Public Function TextFileToStringArray(ByVal vFileName As String, _
  Optional ByVal vDelim As String = ",") As String()
    Dim vFF As Long, vFileCont() As String, vTempStr As String, vTempArr, vTempArr2
    Dim LineCt As Long, ColCt As Long, i As Long, j As Long
    vFF = FreeFile
    LineCt = 0
    ReDim vTempArr2(LineCt)
    Open vFileName For Input As #vFF
    Do Until EOF(vFF)
        Line Input #vFF, vTempStr
        vTempArr = Split(vTempStr, vDelim)
        ReDim Preserve vTempArr2(LineCt)
        vTempArr2(LineCt) = vTempArr
        If UBound(vTempArr) > ColCt Then ColCt = UBound(vTempArr)
        LineCt = LineCt + 1
    Loop
    Close #vFF
    LineCt = LineCt - 1
    ReDim vFileCont(LineCt, ColCt)
    For i = 0 To LineCt
        For j = 0 To UBound(vTempArr2(i))
            vFileCont(i, j) = vTempArr2(i)(j)
        Next 'j
    Next 'i
    TextFileToStringArray = vFileCont
End Function

Function InSArr(ByRef vArray() As String, ByVal vItem As String) As Long
    Dim i As Long, iUB As Long
    iUB = UBound(vArray)
    For i = 0 To iUB
        If vArray(i) = vItem Then
            InSArr = i
            Exit Function
        End If
    Next 'i
    InSArr = -1
End Function

---

Matt

Quote:

---

Originally Posted by mvidas

Hello,

Give the following a try, it will prompt you for the .csv file at runtime. If you have any questions or wish to make any modifications, don't hesitate to ask!

Matt

---

Thanks mvidas

The attached vb script does not work, I do not need a soulution to open a csv file, where I am having the issue is going through the data and seperating the group names with the group users into new sheets.

The 3rd line dows fails with "Subscript out of Range"
[VBA]ReDim vGroupNames(0)
For i = 0 To iUB
If InSArr(vGroupNames, vArr(i, 3)) = -1 Then
ReDim Preserve vGroupNames(vGNCnt)
vGroupNames(vGNCnt) = vArr(i, 3)
vGNCnt = vGNCnt + 1
End If[/VBA]
My attached sheet will explane more, thanks

I'm sorry, I am unable to get your attachment to work, which is why I added the part to open the .csv file.
I am getting "Countif_File.xls: this file is not in the standard Zip 2.0 format. Please see www.winzip.com/zip20.htm for more information". I'll have to try it later from home, perhaps it is just a problem with my work computer (uses Winzip, which I don't use at home).

I did just find an error in my coding[vba]
' vArr = TextFileToStringArray("c:\pipe.txt", ",")
vArr = TextFileToStringArray(vFile, ",")[/vba]

The code I pasted will split it out based on group name, but you could have been receiving the error since you probably dont have a file named "c:\pipe.txt" and that is what it was trying to parse.

If no one else can help you before I get a chance to do this tonight, I'll reply then.

Hello,
I'm attaching an updated copy of your file.
Here is updated code for your Module:[vba]Option Explicit

Sub UpdateFileList()

' Local Variables
Dim rngFileNames As Range
Dim strDir As String, strFileName As String

' Step 1 : Retrieve all file names in selected directory
strDir = "D:\Projects\VPN\B2B\"

strFileName = Dir(strDir & "*.CSV")
Set rngFileNames = Worksheets("Main Menu").Range("B4")
Do While strFileName <> ""
rngFileNames = strFileName
Set rngFileNames = rngFileNames.Offset(1, 0)
strFileName = Dir
Loop

End Sub

Sub OpenCSVFile()

' Local Variables
Dim strDir As String
Dim strFileName As String
Dim vNewSheet As String
Dim vArr() As String
Dim lngCounter As Long
Dim vGNCnt As Long
Dim iUB As Long
Dim jUB As Long
Dim vGroupNames() As String
Dim i As Long
Dim j As Long
Dim r As Long
Dim c As Long

' Step 1 : Turn Screen Updating Off
Application.ScreenUpdating = False

' Step 2 : Set Directory and File Name Variables
strFileName = ActiveCell.Text
strDir = "D:\Projects\VPN\B2B\"

' Step 3 : Verify That Selected File Exists in Named Path
If VerifyFile(strDir, strFileName) = False Then Exit Sub

' Step 4 : Set File Contents to String Array
vArr = TextFileToStringArray(strDir & strFileName)
If UBound(vArr) = 0 Then
MsgBox strFileName & " is blank.", vbOKOnly, "Blank File"
Exit Sub 'Blank file
End If

' Step 5 : Clear Spreadsheet For Input
If Sheets.Count > Worksheets("CSV Data").Index Then
Application.DisplayAlerts = False
For lngCounter = Sheets.Count To Worksheets("CSV Data").Index + 1 Step -1
Sheets(lngCounter).Delete
Next 'lngCounter
Application.DisplayAlerts = True
End If
With Worksheets("CSV Data")
.Cells.ClearContents
.Columns.AutoFit
End With

' Step 6 : Create Group Name Array
vGNCnt = 0
iUB = UBound(vArr, 1)
jUB = UBound(vArr, 2)
ReDim vGroupNames(0)
For i = 1 To iUB
If InSArr(vGroupNames, vArr(i, 3)) = -1 Then
ReDim Preserve vGroupNames(vGNCnt)
vGroupNames(vGNCnt) = vArr(i, 3)
vGNCnt = vGNCnt + 1
End If
Next 'i
vGNCnt = vGNCnt - 1

' Step 7 : Enter All Data To CSV Data Sheet and Sort Sheet
With Worksheets("CSV Data").Range("A1").Resize(iUB + 1, jUB + 1)
.Value = vArr
.Columns.AutoFit
.Sort Key1:=.Parent.Range("D2"), Order1:=xlAscending, Header:=xlYes
End With

' Step 8 : Add New Worksheets For Each Group Name
For j = 0 To vGNCnt
vNewSheet = Left(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(vGroupNames(j), ":", ""), "\", ""), "\", ""), "?", "") _
, "*", ""), "[", ""), "]", ""), 31)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = vNewSheet
For i = 0 To jUB
Cells(1, i + 1) = vArr(0, i)
Next 'i
r = 2
For i = 1 To iUB
If vArr(i, 3) = vGroupNames(j) Then
For c = 1 To jUB + 1
Cells(r, c) = vArr(i, c - 1)
Next 'c
r = r + 1
End If
Next 'i
Columns.AutoFit
ActiveSheet.UsedRange.Sort Key1:=Range("D2"), Header:=xlYes
Next 'j

' Step 9 : Return to Main Menu and Turn Screen Updating On
Sheets("Main Menu").Select
Application.ScreenUpdating = True

End Sub

Public Function VerifyFile(ByVal vPath As String, ByVal vFileName As String) As Boolean
Dim vFF As Long, vErrNum
VerifyFile = True
vFF = FreeFile
On Error Resume Next
Open vPath & vFileName For Random As #vFF
vErrNum = Err.Number
On Error GoTo 0
If vErrNum <> 0 Then
MsgBox "The following file " & vbCrLf & vFileName & vbCrLf & vbCrLf & _
"Does not appear to exist in the following folder" & vbCrLf & vPath & vbCrLf, _
vbCritical + vbOKOnly, "Unable to locate filename entered!!"
VerifyFile = False
End If
Close #vFF
End Function

Public Function TextFileToStringArray(ByVal vFileName As String, _
Optional ByVal vDelim As String = ",") As String()
Dim vFF As Long, vFileCont() As String, vTempStr As String, vTempArr, vTempArr2
Dim LineCt As Long, ColCt As Long, i As Long, j As Long

vFF = FreeFile
LineCt = 0
ReDim vTempArr2(LineCt)
ReDim vFileCont(0)
Open vFileName For Input As #vFF
Do Until EOF(vFF)
Line Input #vFF, vTempStr
vTempArr = Split(vTempStr, vDelim)
ReDim Preserve vTempArr2(LineCt)
vTempArr2(LineCt) = vTempArr
If UBound(vTempArr) > ColCt Then ColCt = UBound(vTempArr)
LineCt = LineCt + 1
Loop
Close #vFF
LineCt = LineCt - 1

If LineCt >= 0 And ColCt >= 0 Then ReDim vFileCont(LineCt, ColCt)

For i = 0 To LineCt
For j = 0 To UBound(vTempArr2(i))
vFileCont(i, j) = vTempArr2(i)(j)
Next 'j
Next 'i
TextFileToStringArray = vFileCont
End Function

Function InSArr(ByRef vArray() As String, ByVal vItem As String) As Long
Dim i As Long, iUB As Long
iUB = UBound(vArray)
For i = 0 To iUB
If vArray(i) = vItem Then
InSArr = i
Exit Function
End If
Next 'i
InSArr = -1
End Function[/vba]

It uses a bit different method than you were doing, but this is much more efficient. If you want me to write you code as an addition to what you had, I can do that, but I'd recommend the above instead.
Let me know!
Matt

Quote:

---

Originally Posted by mvidas

Hello,
If you want me to write you code as an addition to what you had, I can do that, but I'd recommend the above instead.
Let me know!
Matt

---

Matt,
Thanks, It is what I was trying to to, I still have problems with the Main sheet
where I need to list all groups and total logins for each group and then when selected display the users in window two with total logins.

You are the best, thanks for your assistance, I am still learning Vb so your help is VERY MUCH Appreciated :bow:

Matt, Is there a way to change this from reading from the CSV delimeted file
after the first time, to read from the sheet "CSV Data"
because I need to delete the column for "AAA Server" before creating the seperate group sheets. this should spped up imports because there are over 30000 records.

[VBA]
' Step 9 : Add New Worksheets For Each Group Name
For j = 0 To vGNCnt
vNewSheet = Left(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(vGroupNames(j), ":", ""), "\", ""), "\", ""), "?", "") _
, "*", ""), "[", ""), "]", ""), 31)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = vNewSheet
For i = 0 To jUB
Cells(1, i + 1) = vArr(0, i)
Next 'i
r = 2
For i = 1 To iUB
If vArr(i, 3) = vGroupNames(j) Then
For c = 1 To jUB + 1
Cells(r, c) = vArr(i, c - 1)
Next 'c
r = r + 1
End If
Next 'i
Columns.AutoFit
ActiveSheet.UsedRange.Sort Key1:=Range("D2"), Header:=xlYes
Next 'j
[/VBA]
Or could I just exclude the last column from the import? that might me better..

Hi,

I hate to say this, but I have very limited time today at work, I'll be on vacation from tomorrow morning through Tuesday night, and tonight will be spent getting ready for this vacation (among other things). I really don't know if I'll even have a chance to work on your group and login lists.

As for excluding the last column from the import, this is what controls the columns coming in:[vba] For c = 1 To jUB + 1[/vba]
If you change "jUB +1" to just "jUB" then it will skip the last column while splitting it up into the groups.

If you want to have column F removed from the CSV Data sheet, you should be able to change "jUB + 1" to just "jUB" in the first line of Step 7. If that doesn't work, add
.Columns("F").Delete
after the
.Value = ...
line.
I'll have limited time to check this the rest of the day, but I will try and check back at least once more today.
Matt

Thanks for your help, I too was on vacation, Hope you had a good time...

I need to ad a pivot table data to each sheet, I am having some problem
on the naming of each table and placment of the code, any ideas?

[VBA]
pTableName = "PivotTable-" & vNewSheet
Range("G1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="!E5") _
.CreatePivotTable TableDestination:=Range("G1"), TableName:=pTableName

ActiveSheet.PivotTables(pTableName).SmallGrid = False
With ActiveSheet.PivotTables(pTableName).PivotFields("Real Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables(pTableName).PivotFields("Real Name")
.Orientation = xlDataField
.Position = 1
End With
Application.CommandBars("PivotTable").Visible = False
[/VBA]

Hi Matt.:hi: I hope you had a fun vacation.


:sparkle: M-

Hey there, sorry about the delay :) I did have a great vacation, unfortunately it means I have a busier week this week, on top of some new work being thrown at me. But I'll gladly make some time to help you, I'm a sucker for a pretty face!
For your pivot table issue, this had me stumped for a few minutes.. I finally got it though (I use excel 2000 and the help files for the .Add on the pivotcaches is incorrect, thanks to a post on mrexcel.com I was able to figure it out). Here is a new Step 8 for you:
[vba]' Step 8 : Add New Worksheets For Each Group Name
For j = 0 To vGNCnt
vNewSheet = Left(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(vGroupNames(j), ":", ""), "\", ""), "\", ""), "?", "") _
, "*", ""), "[", ""), "]", ""), 31)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = vNewSheet
For i = 0 To jUB
Cells(1, i + 1) = vArr(0, i)
Next 'i
r = 2
For i = 1 To iUB
If vArr(i, 3) = vGroupNames(j) Then
For c = 1 To jUB + 1
Cells(r, c) = vArr(i, c - 1)
Next 'c
r = r + 1
End If
Next 'i
ActiveSheet.UsedRange.Sort Key1:=Range("D2"), Header:=xlYes

pTableName = "PivotTable-" & vNewSheet
Range("G1").Select

'if you are using excel 2000, keep the .Address(0, 0) in here
' if you are using a newer version, you may have to take it out
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Range("A1", Cells(r - 1, c - 1)).Address(0, 0)) _
.CreatePivotTable TableDestination:=Range("G1"), TableName:=pTableName

ActiveSheet.PivotTables(pTableName).SmallGrid = False
With ActiveSheet.PivotTables(pTableName).PivotFields("Real Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables(pTableName).PivotFields("Real Name")
.Orientation = xlDataField
.Position = 1
End With
Application.CommandBars("PivotTable").Visible = False

Columns.AutoFit
Next 'j[/vba]
Are you still having a problem with your Main sheet? If so, are you wanting it to go via the pivot table method like you have originally, or would you be open to a new way to do it?
Matt

Matt,
Thanks for the Nice words your sweet, thanks for your help.

One thing that I found is that pivot tables are very large and if I have several
groups my workbook will be in the many gigabytes range :bug:

Tony was able to help me out with the main sheet issue on another forum.
http://www.ozgrid.com/forum/showthre...993#post172993

So after looking at his code I thought to myself, why don't I just copy the main sheet user data to it's group sheet like in column G2.

I love your solution to my create sheet issue it works great :thumb .

I am still trying to figure out tony's code, but is work well
see below:
[VBA]
Sub GetGroups()

Sheets("main menu").Range("d6:e30").ClearContents

lastrow = Sheets("CSV Data").Range("d65536").End(xlUp).Row
Dim nodupes As New Collection
For Each ce In Sheets("CSV Data").Range("D2:D" & lastrow)
On Error Resume Next
nodupes.Add Item:=ce, key:=CStr(ce)
Next ce

For i = 1 To nodupes.Count
Sheets("Main Menu").Range("d5").Offset(i, 0).Value = nodupes(i)
Sheets("Main Menu").Range("d5").Offset(i, 1).Value = WorksheetFunction.CountIf(Sheets("csv data").Range("d1:d" & lastrow), nodupes(i))
Next i

End Sub
[/VBA]

[VBA]
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D6:D30")) Is Nothing Then
Range("G6:I30").ClearContents
lastrow = Sheets("csv data").Range("e65536").End(xlUp).Row
Dim nodupes As New Collection
For Each ce In Sheets("csv data").Range("d2:d" & lastrow)
If ce = Target.Value Then
On Error Resume Next
nodupes.Add Item:=ce.Offset(0, 1), key:=CStr(ce.Offset(0, 1))
End If
Next ce
For i = 1 To nodupes.Count
Sheets("Main Menu").Range("G5").Offset(i, 0).Value = nodupes(i)
Sheets("Main Menu").Range("G5").Offset(i, 1).Value = WorksheetFunction.CountIf(Sheets("csv data").Range("E2:E" & lastrow), nodupes(i))
Next i

'Sheets("Main Menu").Range("I65536").End(xlUp).Offset(1, 0).Value = Evaluate("=SUM(I6:I" & Worksheets("Main Menu").Range("I65536").End(xlUp).Row & ")")
End If

End Sub
[/VBA]

:friends: I just want to say that all you guys on this site are fantastic
Thanks for everything:beerchug:

Quote:

---

Originally Posted by Amnicbra

Here is me --> :banghead:
I can't Figure out :dunno a simple VB Function...

I am trying to sort a CSV file and create sheets from it
|A |B |C |D |E
DateTimeUser-NameGroup-NameReal Name

I need to sort the file on "Group-Name" then create several sheets all named
as the groups located in the CSV File (there are about 20 group names but thousands of instances) then extract the "User-Names" assosiated to the group
an insert the thousands of names in to the sheet.

Ok Maybe not so Simple :doh: I attached sample below

---

Hi
I'm trying to do the opposite. To write something that will loop thru all sheets and create a seperate csv for each one. csv1 from sheet1, csv2 from sheey 2 etc
Any ideas?