3
\$\begingroup\$

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.

enter image description here

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
asked Jan 20, 2017 at 14:23
\$\endgroup\$
2
  • \$\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\$ Commented 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\$ Commented Jan 29, 2017 at 11:59

1 Answer 1

1
\$\begingroup\$

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
answered Feb 14, 2017 at 18:25
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.