This is really my first time using a class and I originally wrote it without the class and without refactoring.
This is to take two inputs (csv), place the data in arrays and then compare the arrays. Both inputs have the exact same structure e.g.
It returns any matches that have the same C,D,E,W
and gives the header (Var) as well as the previous and current values. I didn't name the headers.
I don't have rubberduck installed.
Option Explicit
Public Sub Delta_Var()
Const PROMPT As String = "The Results sheet already exists. Do you want to continue and overwrite the data?"
Dim SheetCheck As Boolean
SheetCheck = GetResultSheet(PROMPT)
If Not SheetCheck Then Exit Sub
Application.ScreenUpdating = False
Dim originalDataArray As Variant
originalDataArray = GetData(1)
If IsEmpty(originalDataArray) Then GoTo Cleanup
Dim newDataArray As Variant
newDataArray = GetData(0)
If IsEmpty(newDataArray) Then GoTo Cleanup
Dim resultSheet As Worksheet
Set resultSheet = ThisWorkbook.Sheets("Results")
ModelResults
Dim originalRecords() As String
ReDim originalRecords(1 To UBound(originalDataArray))
Dim newRecords() As String
ReDim newRecords(1 To UBound(newDataArray))
originalRecords() = PopulateDataArray(originalDataArray)
newRecords = PopulateDataArray(newDataArray)
Dim matchOriginalToNew() As Variant
ReDim matchOriginalToNew(1 To UBound(newRecords), 1 To 2)
matchOriginalToNew = MatchRecords(newRecords, originalRecords)
PopulateResults originalDataArray, newDataArray, matchOriginalToNew, resultSheet
resultSheet.Columns.AutoFit
resultSheet.Columns.HorizontalAlignment = xlCenter
Cleanup:
Application.ScreenUpdating = True
End Sub
Private Function MatchRecords(ByRef newRecords() As String, ByRef originalRecords() As String) As Variant
Dim matchArray As Variant
ReDim matchArray(1 To UBound(newRecords), 1 To 2)
Dim recordIndex As Long
Dim arrayIndex As Long
Dim matchCounter As Long
matchCounter = 1
For recordIndex = LBound(newRecords) To UBound(newRecords)
For arrayIndex = LBound(originalRecords) To UBound(originalRecords)
If newRecords(recordIndex) = originalRecords(arrayIndex) Then
matchArray(matchCounter, 1) = arrayIndex
matchArray(matchCounter, 2) = recordIndex
matchCounter = matchCounter + 1
End If
Next
Next
MatchRecords = matchArray
End Function
Private Function PopulateDataArray(ByVal dataArray As Variant) As String()
Dim arrayRecord() As String
ReDim arrayRecord(1 To UBound(dataArray))
Dim arrayIndex As Long
For arrayIndex = LBound(dataArray) To UBound(dataArray)
arrayRecord(arrayIndex) = dataArray(arrayIndex, 3) & dataArray(arrayIndex, 4) & dataArray(arrayIndex, 5) & dataArray(arrayIndex, 58)
Next
PopulateDataArray = arrayRecord
End Function
Private Function GetData(ByVal first As Boolean) As Variant
Dim lastRow As Long
Dim fileName As String
If first Then
Dim originalBook As Workbook
Dim originalSheet As Worksheet
fileName = File_Picker(True)
On Error GoTo ErrorHandler
Set originalBook = Workbooks.Open(fileName)
Set originalSheet = originalBook.Sheets(1)
Dim originalDataRange As Range
lastRow = originalSheet.Cells(Rows.Count, 1).End(xlUp).Row
GetData = originalSheet.Range(originalSheet.Cells(1, 1), originalSheet.Cells(lastRow, 58))
originalBook.Close
Else:
Dim newBook As Workbook
Dim newSheet As Worksheet
fileName = File_Picker(False)
Set newBook = Workbooks.Open(fileName)
Set newSheet = newBook.Sheets(1)
Dim newDataRange As Range
lastRow = newSheet.Cells(Rows.Count, 1).End(xlUp).Row
GetData = newSheet.Range(newSheet.Cells(1, 1), newSheet.Cells(lastRow, 58))
newBook.Close
End If
Exit Function
ErrorHandler:
MsgBox "you've cancelled"
End Function
Private Function GetResultSheet(ByVal PROMPT As String) As Boolean
Const RESULT_SHEET_NAME As String = "Results"
Dim continue As VbMsgBoxResult
If WorksheetExists(RESULT_SHEET_NAME) Then
continue = MsgBox(PROMPT, vbYesNo)
If continue = vbNo Then
GetResultSheet = False
Exit Function
Else:
GetResultSheet = True
Exit Function
End If
End If
ThisWorkbook.Worksheets.Add
ThisWorkbook.Worksheets(Worksheets.Count - 1).Name = "Results"
GetResultSheet = True
End Function
Function WorksheetExists(sName As String) As Boolean
WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function
Private Sub ModelResults()
Const HEADER_ROW As Long = 1
With ThisWorkbook.Sheets("Results")
.UsedRange.Clear
.Cells(HEADER_ROW, 1) = "Subject"
.Cells(HEADER_ROW, 2) = "Folder"
.Cells(HEADER_ROW, 3) = "Occured_on"
.Cells(HEADER_ROW, 4) = "Timepoint"
.Cells(HEADER_ROW, 5) = "VAR"
.Cells(HEADER_ROW, 6) = "Previous Value"
.Cells(HEADER_ROW, 7) = "New Value"
.Range("A1:G1").Font.Bold = True
End With
End Sub
Private Function File_Picker(ByVal original As Boolean) As String
Dim version As String
Dim workbookName As String
If original Then
version = "original"
Else: version = "new"
End If
Dim selectFile As FileDialog
MsgBox "Please select the file with your " & version & " data."
Set selectFile = Application.FileDialog(msoFileDialogOpen)
With selectFile
.AllowMultiSelect = False
.Title = "Select the file with your " & version & " data."
.Filters.Clear
.Filters.Add "Excel Document", ("*.csv, *.xls")
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then
Dim selectedItem
For Each selectedItem In selectFile.SelectedItems
File_Picker = selectedItem
Next selectedItem
End If
End With
Set selectFile = Nothing
End Function
Private Sub PopulateResults(ByVal originalDataArray As Variant, ByVal newDataArray As Variant, ByVal matchOriginalToNew As Variant, ByVal resultSheet As Worksheet)
Dim records As Collection
Set records = New Collection
Dim result As RecordResult
Dim recordIndex As Long
Dim originalIndex As Long
Dim newIndex As Long
Dim columnIndex As Long
Dim i As Long
For recordIndex = LBound(matchOriginalToNew) To UBound(matchOriginalToNew)
originalIndex = matchOriginalToNew(recordIndex, 1)
newIndex = matchOriginalToNew(recordIndex, 2)
For columnIndex = 6 To 56
If originalDataArray(originalIndex, columnIndex) <> newDataArray(newIndex, columnIndex) Then
Set result = New RecordResult
result.Subject = originalDataArray(originalIndex, 3)
result.Folder = originalDataArray(originalIndex, 4)
result.Occurence = originalDataArray(originalIndex, 5)
result.Timepoint = originalDataArray(originalIndex, 58)
result.Var = originalDataArray(1, columnIndex)
result.OriginalValue = originalDataArray(originalIndex, columnIndex)
result.NewValue = newDataArray(newIndex, columnIndex)
records.Add result
End If
Next
Next
With resultSheet
For i = 1 To records.Count
resultSheet.Cells(i + 1, 1) = records(i).Subject
resultSheet.Cells(i + 1, 2) = records(i).Folder
resultSheet.Cells(i + 1, 3) = records(i).Occurence
resultSheet.Cells(i + 1, 4) = records(i).Timepoint
resultSheet.Cells(i + 1, 5) = records(i).Var
resultSheet.Cells(i + 1, 6) = records(i).OriginalValue
resultSheet.Cells(i + 1, 7) = records(i).NewValue
Next
End With
End Sub
And the Class Module RecordResult
Option Explicit
Private pSubject As String
Private pFolder As String
Private pOccurence As Date
Private pTimepoint As String
Private pVar As String
Private pOriginalValue As Double
Private pNewValue As Double
Public Property Get Subject() As String
Subject = pSubject
End Property
Public Property Get Folder() As String
Folder = pFolder
End Property
Public Property Get Occurence() As Date
Occurence = pOccurence
End Property
Public Property Get Timepoint() As String
Timepoint = pTimepoint
End Property
Public Property Get Var() As String
Var = pVar
End Property
Public Property Get OriginalValue() As Double
OriginalValue = pOriginalValue
End Property
Public Property Get NewValue() As Double
NewValue = pNewValue
End Property
Public Property Let Subject(Value As String)
pSubject = Value
End Property
Public Property Let Folder(Value As String)
pFolder = Value
End Property
Public Property Let Occurence(Value As Date)
pOccurence = Value
End Property
Public Property Let Timepoint(Value As String)
pTimepoint = Value
End Property
Public Property Let Var(Value As String)
pVar = Value
End Property
Public Property Let OriginalValue(Value As Double)
pOriginalValue = Value
End Property
Public Property Let NewValue(Value As Double)
pNewValue = Value
End Property
-
\$\begingroup\$ I know the site is about giving advice on code, however I'd appreciate to know you specific question. Do you have any (performance) issue with it? Or would like to know best practices on classes?... \$\endgroup\$Máté Juhász– Máté Juhász2017年01月28日 20:56:38 +00:00Commented Jan 28, 2017 at 20:56
-
\$\begingroup\$ @MátéJuhász Probably whether I can use the class more efficiently. I don't really have any future need for the macro, but I usually refer back to my questions when I write new ones \$\endgroup\$Raystafarian– Raystafarian2017年01月29日 11:59:11 +00:00Commented Jan 29, 2017 at 11:59
1 Answer 1
Naming
No need to use different naming for Class modules than regular modules, so no need for pSubject
when it can just be subject
.
Additionally, passing arguments called Value
isn't necessary, you can use regular variable names, as well as pass then ByVal
:
Option Explicit
Private testSubject As String
Private testingFolder As String
Private occurenceDate As Date
Private pointInTime As String
Private testVariableName As String
Private originalValue As Double
Private newValue As Double
Public Property Get Subject() As String
Subject = testSubject
End Property
Public Property Get Folder() As String
Folder = testingFolder
End Property
Public Property Get Occurence() As Date
Occurence = occurenceDate
End Property
Public Property Get Timepoint() As String
Timepoint = pointInTime
End Property
Public Property Get Var() As String
Var = testVariableName
End Property
Public Property Get originalValue() As Double
originalValue = originalValue
End Property
Public Property Get newValue() As Double
newValue = newValue
End Property
Public Property Let Subject(ByVal subjectInput As String)
testSubject = subjectInput
End Property
Public Property Let Folder(ByVal folderInput As String)
testingFolder = folderInput
End Property
Public Property Let Occurence(ByVal occuredOn As Date)
occurenceDate = occuredOn
End Property
Public Property Let Timepoint(ByVal timePointInput As String)
pointInTime = timePointInput
End Property
Public Property Let Var(ByVal varName As String)
testVariableName = varName
End Property
Public Property Let originalValue(ByVal originalData As Double)
originalValue = originalData
End Property
Public Property Let newValue(ByVal newData As Double)
newValue = newData
End Property