Work with a folder of files

This is a little more code than I usually want to post, but it all fits together – and isn’t a complete set. 


Public Sub GetSheets()
Dim fd As FileDialog
Dim varRootFolder As Variant
Dim strRootPath As String
Dim strTimeSheetFileName As String
Dim strCompilerFileName As String


strRootPath = ActiveWorkbook.Path
strCompilerFileName = ActiveWorkbook.Name
'Select Root folder

We will use the file dialog to have the user select a folder of data. This requires a reference.
These settings will allow a single folder only and start where the current folder resides.

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select a folder to compile"
.AllowMultiSelect = False
.InitialFileName = strRootPath
If .Show = -1 Then

This loop will use the name of the selected folder and add a \

For Each varRootFolder In .SelectedItems
strRootPath = varRootFolder & "\"
Next varRootFolder

End If


End With
Set fd = Nothing

Next we count the Excel files in the selected folder.

'Count all files under Root folder

strSheetFileName = Dir(strRootPath & "*.Xlsx")
Do While strSheetFileName <> ""
If strSheetFileName <> strCompilerFileName Then
FileCount = FileCount + 1
end if
strSheetFileName = Dir()
Loop

Working with a month’s data

This subroutine will increment a month in a provided cell.

Sub AddMonth()
Dim sDate As String, dDate As Date

setUp

Sheets("Month").Select
Range("A3").Select
If IsNull(Sheets("Month").Range("A3").Select) Or Sheets("Month").Range("A3").Value = "" Then
Selection.End(xlToRight).Select
End If
sDate = ActiveCell.Value
dDate = CDate(sDate)

If Day(dDate) 1 Then
dDate = DateAdd("D", -Day(dDate) + 1, dDate)
End If
dDate = DateAdd("M", 1, dDate)
Sheets("Month").Range("G1:H1").Value = Format(dDate, "mmmm-yyyy")
fillMonth dDate

closeOut
End Sub

Then you can update a given month

Sub UpdateMonth()
Dim sDate As String, dDate As Date
setUp
Sheets("Month").Select
Range("A3").Select
If IsNull(Range("A3").Select) Or Range("A3").Value = "" Then
Selection.End(xlToRight).Select
End If
sDate = Sheets("Month").Range("G1").Value
dDate = CDate(sDate)

fillMonth dDate
closeOut
End Sub

Or decrement a month

Sub SubMonth()
setUp
Dim sDate As String, dDate As Date

Sheets("Month").Select
Range("A3").Select
If IsNull(Range("A3").Select) Or Range("A3").Value = "" Then
Selection.End(xlToRight).Select
End If
sDate = ActiveCell.Value
dDate = CDate(sDate)

If Day(dDate) 1 Then
dDate = DateAdd("D", -Day(dDate) + 1, dDate)
End If
dDate = DateAdd("M", -1, dDate)
Range("G1:H1").Value = Format(dDate, "mmmm-yyyy")
fillMonth dDate
closeOut
End Sub

Is it a number?

Sometimes you’re working with a large amount of data, and you only want the numbers to be added to a total. This function will convert all non numbers to 0 and add it to the total you pass in.
 

Function convertHours(sHours As String, dHours As Double) As String
If dHours = 0 Then
sHours = "0"
Else
If Not IsNumeric(sHours) Then
sHours = "0"
End If
End If
convertHours = sHours
End Function

Hiding Actions

Sometimes you want to hide what you’re processing in VBA from the user. This code will help – call the SetUp module before your other code and CloseOut when you’re done.


Sub setUp()

‘Get current state of various Excel settings; put this at the beginning of your code
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
displayPageBreakState = ActiveSheet.DisplayPageBreaks ‘note this is a sheet-level setting

‘turn off some Excel functionality so your code runs faster
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
‘Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False ‘note this is a sheet-level setting

End Sub

… 


Sub closeOut()
'end your code

‘after your code runs, restore state; put this at the end of your code
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState ‘note this is a sheet-level setting
End Sub

 

Get files in a folder

Sometimes you needfo work with external files, this code will let you pick a folder.

Select Root folderSet fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

.Title = "Select a folder to compile"

.AllowMultiSelect = False

.InitialFileName = strRootPath

If .Show = -1 Then

For Each varRootFolder In .SelectedItems

strRootPath = varRootFolder & "\"

Next varRootFolder

Else

End If

End With

Set fd = Nothing

Delete all the data?

Say you’re processing a bunch of information and you need to clear a sheet. 

' Delete any/all records
If (ActiveSheet.UsedRange.Rows.Count) > 1 Then
'wsMasWorksheet.Range("A2").Select
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'Selection.Delete Shift:=xlUp

wsMasWorksheet.Rows("2:65000").Select
Selection.Delete shift:=xlUp
lngResRng = ActiveSheet.UsedRange.Rows.Count
End If

 
Say goodbye to everything in the sheet from A2 to A65000 – all rows will be deleted.

But I want to look at all of it

Ok So you want to go through all the data in a column in your work sheet 

Dim iRows as Long
iRows = 45
For iRow = 3 To iRows

 
if you’re using any version of excel higher than ’97 – you need to use Long not Integer – or you will see failures in higher rows.
 
Here we are just going to check if colmn G is x and then set column I. You could achieve this with an if statment in column I.

If Sheets("Data").Range("G" & CStr(iRow)).Value = "x" Then
Sheets("Data").Range("I" & CStr(iRow)).Value =45
Else
Sheets("Data").Range("I" & CStr(iRow)).Value =52
End If
Next iRow

I caught you…

This one will catch when you leave the cell specified 


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$13" Then

'Your code for when user leaves cell B13

End If
End Sub