Wednesday, September 16, 2015

VBA Excel - Run macro for copying formula in each file of a folder

Private Sub CommandButton1_Click()
Dim Filename, Pathname As String
Dim wb As Workbook

    Pathname = ActiveWorkbook.Path & "\Files\"
    Filename = Dir(Pathname & "*.xlsm")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

    Sub DoWork(wb As Workbook)
    With wb
    Dim rng
rng = "P4:P23"
.Sheets(1).Range("P4").Select

Selection.AutoFill Destination:=.Sheets(1).Range(rng)
    .Sheets(1).Range(rng).Select
       
    End With
End Sub



Sunday, September 13, 2015

Excel- find file name only from a directory path

=TRIM(RIGHT(SUBSTITUTE(A1,"\",REPT(" ",LEN(A1))),LEN(A1)))

Source: http://stackoverflow.com/questions/18617349/excel-last-character-string-match-in-a-string

Monday, September 7, 2015

VBA - sheet creation and row copy from a consolidated sheet

Module 1 : creation of list of unique values

Range("A1:A10").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$G$1:$G$10").RemoveDuplicates Columns:=1, Header:=xlYes

Module 2: Creation of sheets from list.

Taken from : http://ccm.net/faq/27361-excel-a-macro-to-create-and-name-worksheets-based-on-a-list
Sub CreateSheetsFromAList() 
    Dim MyCell As Range, MyRange As Range 
     
    Set MyRange = Sheets("Summary").Range("A10") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

    For Each MyCell In MyRange 
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet 
    Next MyCell 
End Sub 

Module 3: Copy based on list

Algo: run loop for unique values
Find each row and copy to respective sheet.