Jump to content
Tactically Inept

Code


Malaphax

Recommended Posts

I mentioned that I've been working pretty heavily with some VBA recently in attempt to help improve some workflow, and improve my own programming capabilities. So I'll go ahead and post some of my code here with some additional comments to help break down what it is and what I'm trying to do. Maybe Jedi2155 will have some insights as someone who's been working with VBA far longer than I have.

'Begining Code for Mass CSV Import 11/12/14

Dim fs  As New FileSystemObject
Dim fo As Folder
Dim fi As File
Dim wb As Workbook
Dim ws As Worksheet
Dim sname As String
Dim i As Integer
Dim j As Integer

Option Explicit
Sub loadall()
    Set wb = ThisWorkbook

    Set fo = fs.GetFolder("C:\Users\Username\Downloads\CSV")

    For Each fi In fo.Files
        If UCase(Right(fi.Name, 4)) = ".CSV" Then
            sname = Replace(Replace(Replace(fi.Name, ":", "_"), "\", "-"), ".csv", "")

            Set ws = wb.Sheets.Add
            ws.Name = sname
            Call yourRecordedLoaderModified(fi.Path, ws)
            Call delete
            Call macroloop
            Call sort
        End If
    Next
End Sub

Sub yourRecordedLoaderModified(what As String, where As Worksheet)
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & what, Destination:=Range("$A$1"))
    .Name = "test1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
End Sub
'Running Macro for data cleanup.
Sub macroloop()
    Worksheets(1).Activate
    For Each ws In ActiveWorkbook.Worksheets
        Sheets(ActiveSheet.Name).Select
        If InStr(1, ActiveSheet.Range("A1").Text, "As of Date") > 0 Then
        Columns("A:C").delete Shift:=x1ToLeft
        Columns("B:B").Cut
        Columns("A:A").Insert Shift:=xlToRight
        Columns("A:J").Select
        Selection.AutoFilter
        Selection.Columns.AutoFit
        End If
    Next ws
End Sub
'Running Delete Empty Sheets.
Sub delete()
Sheets.Add After:=Sheets(Sheets.Count)

    Application.DisplayAlerts = False
    
    For Each sh In Sheets
        If IsEmpty(sh.UsedRange) Then sh.delete
    Next
    Application.DisplayAlerts = False
End Sub
'Sort Worksheets Alphanumerically
Sub sort()
    For i = 1 To Sheets.Count
        For j = 1 To Sheets.Count - 1
            If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
        Sheets(j).Move After:=Sheets(j + 1)
        End If
        Next j
    Next i
End Sub

The first sub is performing several calls to other subs, as well as starting the importing a collection of CSV files from a specific directory.

The second sub is continuing to load all the CSVs. I took both of these pieces of code from here:

http://stackoverflow.com/questions/12162477/importing-multiple-csv-to-multiple-worksheet-in-a-single-workbook

 

The third sub (macroloop) is running a very basic set of instructions to clean up some of the data I am working with, some of the columns needed to be removed and re-ordered.

 

The fourth sub (delete) is deleting any blank worksheets from the workbook, I took that code from here:

http://stackoverflow.com/questions/18594223/how-to-delete-a-blank-sheet-in-a-workbook-using-vba

 

The fifth sub (sort) sorts each worksheet in alphanumeric order. I took that and modified it from here:

http://support.microsoft.com/kb/812386/en-us

 

 

The downside is that the first two subs require Microsoft Scripting Runtime enabled, I'm currently looking at adding another piece of VBA which automatically enables that reference such as this:

http://stackoverflow.com/questions/9879825/how-to-add-a-reference-programmatically-vba-excel

Link to comment
Share on other sites

  • 4 weeks later...

Thanks for the offer Richard, I'm not really worried about what I have posted. It is currently working, I just have to enable a specific reference library before using it. I'm currently working on an entirely different project to do with taxes which I might use a template for, but no vba code.

 

I ran into issues with referencing closed workbooks, and referencing password protected workbooks, but neither of those actually caused any major setbacks.

 

In general I feel like my excel capabilities have increased quite a bit, and while I personally do not consider myself an expert, I will be putting on my resume that I'm an expert.

Link to comment
Share on other sites

  • 1 month later...

I've been working on a project for a few days now which revolves around mass folder creation and a large file migration.
I'm sitting here watch my 600 line batch script chugging away. I probably have a huge shit eating grin on my face right now.

Here's a brief rundown my incredibly basic code.

This is a powershell folder generation script.

Set-Location "C:\Destination Directory"
 
$Folders = Import-Csv C:\Users\username\Documents\filename.csv
 
ForEach ($Folder in $Folders) {
 
New-Item $Folder.Name -type directory
}

This is grabbing a list of directories from a csv that I want created. You can list the sub directories and it will automagically generate the parent directories.

Here's the first 3 lines from the csv:
Name
ClientName\12345678
ClientName\123456790

You need the "Name" heading.

In this case it's going to create a parent folder of
C:\Destination Directory\ClientName

and two subfolders:
C:\Destination Directory\ClientName\ClientName\12345678
C:\Destination Directory\ClientName\ClientName\123456790

Take note, you do not need to put surrounding quotes on the file names even if they have spaces. Powershell seems to handle that just fine.

 

I'm also using a really basic form of subfolder creation as a batch script.

FOR /d %%A IN (C:\Destination Directory\*) DO mkdir "%%A\Performance Report"

Finally I have my mass file copy batch script:

for /r "C:\Initial Directory\Client Name" %%f in (*) do @copy "%%f" "C:\Destination Directory\Client Name"

Take note that this last script does not copy file structure, which is what I specifically wanted. So it will grab every file in all subfolders from the Initial directory and throw them in the matching directory. I put together a big excel document matching all the folder names and copied that over to the batch script. Also if you're extra brave you could technically use @move instead of copy.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...