VBA-Alignment of dates

Public Sub AlignDate()
Dim X() As Variant
Dim shtArr() As Integer
Dim smallest_date As Date
Dim largest_date As Date
Dim fwdFill As Boolean
Application.ScreenUpdating = False
Start:
If Sheet1.OptionButton1.Value Then
fileType = Sheet1.OptionButton1.Caption
mulSel = True
X = Application.GetOpenFilename(filefilter:=fileType & " Files,*." & fileType, _
MultiSelect:=mulSel, Title:="File(s) to be aligned")
'Tests the variable X to see if it is valid
If UBound(X) = 0 Then Exit Sub
ReDim shtArr(1)
shtArr(1) = 1
smallest_date = minDateCSV(X(), shtArr())
largest_date = maxDateCSV(X(), shtArr())
ElseIf Sheet1.OptionButton2.Value Then
fileType = Sheet1.OptionButton2.Caption
mulSel = False
Target = Application.GetOpenFilename(filefilter:=fileType & " Files,*." & fileType, _
MultiSelect:=mulSel, Title:="File(s) to be aligned")
If Target = False Then Exit Sub
ReDim X(1) As Variant
X(1) = Target
smallest_date = minDateXL(X(), shtArr())
largest_date = maxDateXL(X(), shtArr())
Else
MsgBox Prompt:="Select a File Type First", Buttons:=vbCritical
Exit Sub
End If
If Sheet1.OptionButton3.Value Then
fwdFill = True
ElseIf Sheet1.OptionButton4.Value Then
fwdFill = False
Else
MsgBox Prompt:="Select Whether to forward fill or not", Buttons:=vbCritical
Exit Sub
End If
MsgBox smallest_date
Application.ScreenUpdating = True
MsgBox largest_date
If (DateDiff("d", smallest_date, largest_date) <= 0) Then
MsgBox Prompt:="Issue with data. Max date can not be less than or Equal to Min date. Check!!", Buttons:=vbCritical
Exit Sub
End If
If MsgBox("Date Range:- " & smallest_date & " To " & largest_date, vbOKCancel) = vbCancel Then
Exit Sub
End If
Call alignFiles(X(), smallest_date, largest_date, fwdFill)
End Sub
Private Function minDateCSV(X() As Variant, shtArr() As Integer) As Date
Dim smallDates As Date
Dim smallDate As Date
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
Sheets(1).Activate
' Assumption: The Csv file has atleast one line of header and the date is in the 1st column itself. Phew!wat a relief
If IsDate(ActiveSheet.Range("A2").Value) Then
smallDates = ActiveSheet.Range("A2").Value
Else
'If the date is not in the A2 then it is definitely in A3.
smallDates = ActiveSheet.Range("A3").Value
End If
If Y > 1 Then
If (DateDiff("d", smallDates, smallDate) > 0) Then
smallDate = smallDates
End If
Else
smallDate = smallDates
End If
ActiveWorkbook.Close
Next
minDateCSV = smallDate
End Function
Private Function maxDateCSV(X() As Variant, shtArr() As Integer) As Date
Dim largeDates As Date
Dim largeDate As Date
Dim sheet_index As Integer
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
Sheets(1).Activate
' Assumption: The Csv file has more than two lines of input and the date is in column A
' and the data is continuous
largeDates = ActiveSheet.Range("A1").End(xlDown).Value
If Y > 1 Then
If (DateDiff("d", largeDates, largeDate) < 0) Then
largeDate = largeDates
End If
Else
largeDate = largeDates
End If
ActiveWorkbook.Close
Next
maxDateCSV = largeDate
End Function
Private Sub alignFiles(X() As Variant, smallest_date As Date, largest_date As Date, fwdFill As Boolean)
smallest_value = smallest_date
largest_value = largest_date
sheet_index = 1
tdate = smallest_value
'Populating NA and aligning the data
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
For sheet_index = 1 To ActiveWorkbook.Sheets.Count
row = Row_Col(sheet_index)
col = 1
tdate = smallest_value
If row = 0 Then
GoTo x2
End If
Do Until tdate > largest_value
If row = 65537 Then
GoTo x2:
End If
If Sheets(sheet_index).Cells(row, col).Value <= tdate And Sheets(sheet_index).Cells(row, col).Value <> "" Then
GoTo X:
'Ignoring Saturdays and Sundays
ElseIf (DatePart("w", tdate) <> 1 And DatePart("w", tdate) <> 7) Then
Sheets(sheet_index).Cells(row, col).EntireRow.Insert
Sheets(sheet_index).Cells(row, col) = tdate
Sheets(sheet_index).Activate
For count_col = 2 To Sheets(sheet_index).Cells(row - 1, 2).End(xlToRight).Column
If fwdFill Then
If IsNumeric(Sheets(sheet_index).Cells(row - 1, count_col).Value) Then
Sheets(sheet_index).Cells(row, count_col).Value = _
Sheets(sheet_index).Cells(row - 1, count_col).Value
Else
Sheets(sheet_index).Cells(row, count_col).Value = "NA"
End If
Else
Sheets(sheet_index).Cells(row, count_col).Value = "NA"
End If
Next
End If
X:
If (tdate = Sheets(sheet_index).Cells(row, col).Value) Or DatePart("w", tdate) = 1 Or DatePart("w", tdate) = 7 Then
tdate = DateAdd("d", 1, tdate)
End If
If DatePart("w", tdate) <> 1 And DatePart("w", tdate) <> 7 Then
row = row + 1
End If
Loop
x2:
Next
Next
End Sub
Private Function Row_Col(i) As Integer
Dim row, col As Integer
row = 1
col = 1
Do Until Sheets(i).Cells(row, col).Value = ""
If IsDate(Sheets(i).Cells(row, col).Value) Then
Row_Col = row
Exit Function
Else
row = row + 1
End If
Loop
End Function
Private Function minDateXL(X() As Variant, shtArr() As Integer) As Date
Dim smallDates As Date
Dim smallDate As Date
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
For sheet_index = 1 To ActiveWorkbook.Sheets.Count
Sheets(sheet_index).Activate
If (MsgBox("Do you want to include the tab " & ActiveSheet.Name & " in alignment process?", vbYesNo) = vbNo) Then
GoTo hmmm
End If
' Assumption: The Csv file has atleast one line of header and the date is in the 1st column itself. Phew!wat a relief
If IsDate(ActiveSheet.Range("A2").Value) Then
smallDates = ActiveSheet.Range("A2").Value
Else
'If the date is not in the A2 then it is definitely in A3.
smallDates = ActiveSheet.Range("A3").Value
End If
If Y > 1 Then
If (DateDiff("d", smallDates, smallDate) > 0) Then
smallDate = smallDates
End If
Else
smallDate = smallDates
End If
hmmm:
Next
ActiveWorkbook.Close
Next
minDateXL = smallDate
End Function
Private Function maxDateXL(X() As Variant, shtArr() As Integer) As Date
Dim largeDates As Date
Dim largeDate As Date
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
For sheet_index = 1 To ActiveWorkbook.Sheets.Count
Sheets(sheet_index).Activate
If (MsgBox("Do you want to include the tab " & ActiveSheet.Name & " in alignment process?", vbYesNo) = vbNo) Then
GoTo hmmm
End If
' Assumption: The Csv file has more than two lines of input and the date is in column A
' and the data is continuous
largeDates = ActiveSheet.Range("A1").End(xlDown).Value
If Y > 1 Then
If (DateDiff("d", largeDates, largeDate) < 0) Then
largeDate = largeDates
End If
Else
largeDate = largeDates
End If
hmmm:
Next
ActiveWorkbook.Close
Next
maxDateXL = largeDate
End Function