Archive for VBA

Check if a File name is more than 90 days old, & Delete

Selva V Pasupathy, HSBC Global Resourcing, Hyderabad

Option Explicit
‘___________________________________________________________________________
‘***************************************************************************
‘* MODULE NAME:     CODE TO COMPARE IF ANY FILENAME IS > 90 DAYS OLD
‘* AUTHOR:          Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
‘*
‘*
‘* CONTACT:         socko@rediffmail.com
‘* WEB SITE:        https://socko.wordpress.com
‘* NOTES:
‘*  ————————————————————————
‘*  ————————————————————————
‘*
‘*___________________________________________________________________________
‘***************************************************************************

‘ CODE TO COMPARE IF ANY FILENAME IS > 90 DAYS OLD

Const Files_Location = “J:\Falcon\Management\INFILL REPORTS\FCD\”

Sub Delete_Files(ByRef sDir As String)
  Dim i As Integer
  Dim dt2Delete, strDT As Date
  
  With Application.FileSearch
    .LookIn = sDir
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .Execute
  End With
      
  With Application.FileSearch
    If .Execute() > 0 Then
      MsgBox “There were ” & .FoundFiles.Count & _
          ” file(s) found.”
        For i = 1 To .FoundFiles.Count
          MsgBox .FoundFiles(i)
          strDT = Mid(.FoundFiles(i), _
          InStrRev(.FoundFiles(i), ” “, _
          -1, vbTextCompare) + 1, 255)
          
          dt2Delete = Format(Now() – 90, “ddmmyyyy”)
          MsgBox dt2Delete
          If strDT < dt2Delete Then
              MsgBox strDT
              MsgBox “NEED TO DELETE”
          Else
              MsgBox “NEED NOT DELETE”
          End If
        Next i
      Else
          MsgBox “There were no files found.”
      End If
  End With

End Sub

Sub testDeleteFiles()
Call Delete_Files(Files_Location)
End Sub

Advertisements

Leave a Comment

Add Label to Userform Programmatically

Leave a Comment

Consolidating Data from >20 workbooks, each workbook Containing >70 worksheets

– Selva V Pasupathy, HSBC Global Resourcing, Hyderabad

Option Explicit
‘___________________________________________________________________________
‘***************************************************************************
‘*
‘* MODULE NAME:     Copy Data from all Excel Files in a Folder
‘* AUTHOR:          Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
‘*
‘* CONTACT:         socko@rediffmail.com
‘* WEB SITE:        https://socko.wordpress.com
‘*
‘* DESCRIPTION:     The following visual basic code was written when
‘*                  I wanted to consolidate the data from 26 workbooks
‘*                  and in each workbook, there were are 77 sheets. It
‘*                  would have been a very difficult task, if I had to
‘*                  do it manually. I believe this procedure will be
‘*                  useful to somebody else
‘* NOTES:
‘*  Before using the codes, you can change all the variables like,
‘*  Folder, File , SearchString, SearchSubfolders (true / false),
‘*  and other variables.
‘*————————————————————————
‘* Other Information
‘*
‘* UPDATES:
‘*  DATE            COMMENTS
‘*  16 Nov 2008     You are free to use , change, and modify this code.
‘___________________________________________________________________________
‘***************************************************************************

Function ListFiles(sCount As Integer, ByVal sFldr As String, _
                bFldr As Boolean, sFileName As String) As String
Dim fCnt As Integer

    With Application.FileSearch
        .NewSearch
        .LookIn = sFldr
        .SearchSubFolders = bFldr
        .Filename = sFileName             ‘”*consolidated*.xls”
        .FileType = msoFileTypeAllFiles
        
        If .Execute() > 0 Then
            
            If .FoundFiles.Count > sCount Then
              
              For fCnt = 1 To .FoundFiles.Count
                  
                  If fCnt = sCount Then
                    
                    ListFiles = .FoundFiles(fCnt)
                  
                  End If
              
              Next i
            
            Else
            
            ListFiles = “”
            
            End If
        
        Else
            
            MsgBox “There were no files found.”
        
        End If
    
    End With

End Function

Sub Consolidate_Data()
Dim cFile As Integer
Dim sht, rw, cl, avLastRow As Long
Dim myFileName, myFolder, sFileName As String
Dim myFile As Workbook
Dim sFldr As Boolean

myFolder = “J:\GB Project\CONSOLIDATED”
sFldr = False
sFileName = “*consolidated*.xls”

With ThisWorkbook.Sheets(“data”)
  For cFile = 13 To 100
    myFileName = ListFiles(cFile, myFolder, True, sFileName)
    If myFileName = “” Then Exit Sub
      Set myFile = Workbooks.Open(myFileName)
      ThisWorkbook.Activate
      ThisWorkbook.Sheets(“data”).Activate
        For sht = 2 To myFile.Sheets.Count
          For rw = 1 To 100
            avLastRow = .Cells(65536, 1).End(xlUp).Row + 1
            ThisWorkbook.Sheets(“data”).Cells(avLastRow, 1).Activate
            .Cells(avLastRow, 1) = myFile.Sheets(sht).Name
            For cl = 1 To 18
            Application.StatusBar = “Writing File# ” & cFile & _
                    ”  Sheet# ” & sht
            .Cells(avLastRow, cl + 1) = myFile.Sheets(sht).Cells(rw, cl)
            Next cl
          Next rw
        Next sht
  myFile.Close False
  ThisWorkbook.Save
  Next cFile
End With
End Sub

Leave a Comment

Archives

Leave a Comment

Create UserForm at Runtime using Code

– Selva V Pasupathy, HSBC Global Resourcing, Hyderabad

The following code, I found at http://www.eng-tips.com, is the process to create a UserForm dynamically using a macro in VBA.

  1. From the VBE (open Excel and hit ALT+F11)you need to set a reference to the extensibility add-in. To do this, go to Tools/References and find the add-in Micrsoft
    Visual Basic for Applications Extensibility
  2. Create a macro module in the project file. To do this, right-click on VBAProject and
    select Insert->Module.
  3. Right-click the module and select View Code.
  4. Paste this code into the window:

Option Explicit

Sub MakeForm()
  Dim TempForm As Object ' VBComponent
  Dim FormName As String
  Dim NewButton As MSForms.CommandButton
  Dim TextLocation As Integer
  '   ** Additional variable
  Dim X As Integer
  
'Locks Excel spreadsheet and speeds up form processing
  Application.VBE.MainWindow.Visible = False
  Application.ScreenUpdating = False
  
'Create the UserForm
  Set TempForm = ThisWorkbook.VBProject.VBComponents. _
            Add(vbext_ct_MSForm)
  
'Set Properties for TempForm
  With TempForm
    .Properties("Caption") = _
        "HSBC Global Resourcing "
    .Properties("Width") = 400
    .Properties("Height") = 300
  End With
  FormName = TempForm.Name
  
'Add a CommandButton
  Set NewButton = TempForm.Designer.Controls _
    .Add("forms.CommandButton.1")
  With NewButton
    .Caption = "Click Me"
    .Width = 60
    .Height = 24
    .Left = TempForm.Properties("InsideWidth") - 2 - 60
    .Top = TempForm.Properties("insideheight") - 2 - 24
  End With
'Add an event-hander sub for the CommandButton
  With TempForm.CodeModule
'** Delete This: TextLocation = _
      .CreateEventProc("Click","CommandButton1")
  
'** Add/change next 5 lines
'This code adds the commands/event handlers to the form
    X = .CountOfLines
    .InsertLines X + 1, _
          "Sub CommandButton1_Click()"
    .InsertLines X + 2, _
          "MsgBox ""Hello!"""
    .InsertLines X + 3, "Unload Me"
    .InsertLines X + 4, "End Sub"
  End With
  
  '   Show the form
  VBA.UserForms.Add(FormName).Show
  '
  '   Delete the form
  ThisWorkbook.VBProject.VBComponents. _
          Remove VBComponent:=TempForm
End Sub


VBE Programming – www.vbaexpress.com

Leave a Comment

Convert Decimal to RGB Color Value

– Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
Last week , somebody sent me a mail asking if there is a way to convert decimal values of colors to rgb values. I thought excel solver addin already provides different ways to convert binary, decimal, hex values, so the function to convert decimal values to rgb values should be available in solver. But then I was not able to get function to convert decimal to rgb. I tried some functions in excel and made the function to convert decimal to rgb. I am not too sure if this is absolutely correct; but I have tried this with some of the decimals and I am getting the correct rgb value.

HOW SHOULD I USE THE FOLLOWING CODE

Let me know if you have any comment or feedback on this.

Private Function Convert_Dec2RGB(ByVal myDECIMAL As Long) As String
  Dim myRED As Long
  Dim myGREEN As Long
  Dim myBLUE As Long

  myRED = myDECIMAL And &HFF
  myGREEN = (myDECIMAL And &HFF00&) \ 256
  myBLUE = myDECIMAL \ 65536

  Convert_Dec2RGB = CStr(myRED) & "," & CStr(myGREEN) & "," & CStr(myBLUE)
End Sub

Leave a Comment

Clear Controls on Userform

– Selva V Pasupathy, HSBC Global Resourcing, Hyderabad
The following code can be used to clear all textboxes and comboboxes on userform.

HOW SHOULD I USE THE FOLLOWING CODE

Private Sub Clear_all()
    For I = 0 To UserForm1.Controls.Count - 1

        If UCase(TypeName(UserForm1.Controls(I))) = "TEXTBOX" Then
            UserForm1.Controls(I).Value = ""
        End If
        If UCase(TypeName(UserForm1.Controls(I))) = "COMBOBOX" Then
            UserForm1.Controls(I).Value = ""
        End If
    Next I
End Sub

Leave a Comment

Older Posts »