Complicated Excel Sheet including formula and VB Script

[anuradhagrewal]

Dear Experts
I have a complicated issue for which I need your help.
Attached is the csv file 01012020.csv

Problem
I need to import these csv files for each day of 2020 into an excel sheet and create an excel file filtered for each dept.
So for example I have imported csv files from 01012020 to 01032020 I need to create an excel file for all data by filtering for eg: Sales

Help Needed
I would be very grateful if a VB script be suggested where
1)I can import all the csv files (xxxxx(date).csv) into an existing workbook.
2)Now I can run a script where I can delete all other depts. except the one I need. For eg in all the sheets I need data only related to the "IT" dept and the script deletes all other depts mentioned in column C.
3)Then I create a master worksheet with all the names and I am able to do a vlookup based on the sheet name. For eg :In the master worksheet I have the name of all the persons Liam,
Noah, Oliver, William, Elijah, James and for everyday I can see how much percentage of data was used.
In other words when I do a Vlookup I should have the option to select based on the worksheet so I can drag it across all the columns.

Can anybody please please help

Regards

Anu

 

[Zot]

Okay I have time today.

Initially you have to create a workbook in this format, to make things easy

Master worksheet.xlsm
	A	B	C	D	E	F	G	H	I
1		01-Jan-20	02-Jan-20	03-Jan-20	04-Jan-20	05-Jan-20	06-Jan-20	07-Jan-20	08-Jan-20
2	Name	Percentage	Percentage	Percentage	Percentage	Percentage	Percentage	Percentage	Percentage
3
4
5
6
Others

Cell Formulas
Range	Formula
C1:I1	C1	=B1+1

I presumed that you will always have Department "Others". So, the Master workbook has only one worksheet named Others with format above.

Macro will create other dept sheets if necessary and duplicate format. So, your end result would be a workbook with sheets bt department name. You run the same macro until end of the year (with complete a year date on each sheet of course). The workbook name can be anything.

The code

Sub GetDataCSV()

Dim k&, l&, nRow&
Dim strDate$, strDestCol$, strLastCol$, DeptName$, FirstSheet$
Dim DateX As Date
Dim Fname As Variant
Dim cell As Range, rngDate As Range, cellDeptData As Range
Dim rngNameDest As Range, rngDeptData As Range
Dim ws As Worksheet, wsOthers As Worksheet, wsData As Worksheet, wsDest As Worksheet
Dim wbMaster As Workbook, wbData As Workbook
Dim DictSheet As Object

' Define Master workbook and worksheet as variable
Set wbMaster = ActiveWorkbook
Set wsOthers = wbMaster.Sheets("Others")

' Find last column with date and define date range
Set cell = wsOthers.Cells(1, wsOthers.Columns.Count).End(xlToLeft)
Set rngDate = wsOthers.Range("B1", cell)
strLastCol = Split(cell.Address, "$")(1)

' Select source csv data file
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.csv), *.csv", Title:="Select a File")
If Fname = False Then                          'CANCEL is clicked
    Exit Sub
End If

' Define source data workbook and worksheet as variable
Set wbData = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.ActiveSheet

Windows(wbMaster.Name).WindowState = xlMinimized

' Convert string date C1 in CSV file to date variable DateX
strDate = wsData.Range("C1")
If Len(strDate) = 7 Then k = 2: l = 1 Else: k = 3: l = 2
DateX = DateSerial(CInt(Right(strDate, 4)), CInt(Mid(strDate, 2, 2)), CInt(Left(strDate, l)))

' Find last Data row
Set cell = wsData.Range("C" & wsData.Cells.Rows.Count).End(xlUp)
Set rngDeptData = wsData.Range("C3", cell)

' Find date column
For Each cell In rngDate
    If cell = DateX Then
        strDestCol = Split(cell.Address, "$")(1)
        Exit For
    End If
Next

' Create dictionary to register all existing worksheet
Set DictSheet = CreateObject("Scripting.Dictionary")
DictSheet.RemoveAll
For Each ws In wbMaster.Sheets
    If Not DictSheet.exists(ws.Name) Then
        DictSheet.Add ws.Name, ws.Name
    End If
Next

' Prepare dept sheet if not yet exist
For Each cellDept In rngDeptData
    If Not DictSheet.exists(cellDept.Text) Then
        DictSheet.Add cellDept.Text, cellDept.Text
        wbMaster.Sheets.Add(Before:=wsOthers).Name = cellDept
        Set wsDest = wbMaster.Sheets(cellDept.Text)
        wsOthers.Range("A1", strLastCol & "2").Copy Destination:=wsDest.Range("A1")
        wsDest.Range("A1").ColumnWidth = wsOthers.Columns("A").ColumnWidth
        wsDest.Range("A:" & strLastCol).ColumnWidth = wsOthers.Columns("B").ColumnWidth
    End If
Next
   
For Each cellDeptData In rngDeptData
    ' Define range name in Dept destination sheet
    Set wsDest = wbMaster.Sheets(cellDeptData.Text)
    If Not Len(wsDest.Range("A3")) = 0 Then
        Set cell = wsDest.Range("A" & wsDest.Cells.Rows.Count).End(xlUp)
        Set rngNameDest = wsDest.Range("A3", cell)
    Else
        Set rngNameDest = wsDest.Range("A3")
    End If
    ' Transfer data to Dept destination sheet
    Set cell = rngNameDest.Find(cellDeptData.Offset(0, -1).Text, LookAt:=xlWhole)
    If cell Is Nothing Then
        If Not Len(wsDest.Range("A3")) = 0 Then
            nRow = wsDest.Range("A" & wsDest.Cells.Rows.Count).End(xlUp).Row + 1
        Else
            nRow = 3
        End If
    Else
        nRow = cell.Row
    End If
    With wsDest
        .Range("A" & nRow) = cellDeptData.Offset(0, -1)
        With .Range(strDestCol & nRow)
            .Value = cellDeptData.Offset(0, 3)
            .NumberFormat = "0%"
            .HorizontalAlignment = xlRight
            .IndentLevel = 1
        End With
    End With
Next

' Reset cursor to A1 on each sheet
FirstSheet = ""
For Each ws In wbMaster.Sheets
    If FirstSheet = "" Then FirstSheet = ws.Name
    Application.Goto ws.Range("A1"), True
Next
wbMaster.Sheets(FirstSheet).Activate

wbData.Close False
Windows(wbMaster.Name).WindowState = xlMaximized

End Sub

 

[anuradhagrewal]

Hi
The command stops as shown in the pic.
I am also very confused with the code and considering I am a complete novice in VB Macros I have no idea what is happening.

1. As per your instructions to test the code I created a excel workbook with just one sheet named "OTHERS".
2. Now when I run the code it allows me to select only one csv file.
3. And when I run it get stuck here and there is no filtering of depts by "OTHERS".
4. Also I see that it open in a new workbook as date.csv
5. The workbook however makes new workbooks of each dept. (I wanted to make individual workbooks of depts which have nothing to do with depts)

I have no idea what to do.

Can you please tell me

 

[Zot]

What is the error said? I have tested the code with dummy csv with date 1st and 2nd Jan with no problem.

The ideas was to have one workbook with separate sheet for each Dept. The workbook will be filled for a year. So, each workbook for a year.

Sounds like you want a master worksheet will all names (which mean all Depts included). This is just having the same csv file.