Populates Data from one Workbook to Another

Question

Another code clean up I am working on. I have been breaking up my code based on things I have learned here on CR. The code below all works and functions as expected, but I know it can be streamlined more and would like to see how this can be accomplished. The code below was combined into one code block here for ease of copying, but if I need to break it up into the sheet events and standard modules please let me know.

Option Explicit
Private Sub Send_Click()
 SendToQC
End Sub
Option Explicit
Sub SendToQC()
 Dim cYear As String
 cYear = Year(Now())
 Dim nYear As String
 nYear = cYear + 1
 Dim logWBpath As String
 logWBpath = "L:\Loans\Quality Control\QC Log " & nYear & ".xlsx"
 Dim testStr As String
 testStr = ""
 Dim ret As Boolean
 ret = IsWorkBookOpen(logWBpath)
 Select Case ret
 Case Is = True
 Dim msgCap As String
 msgCap = "The QC Log is currently open. Please try again later or manually enter the data."
 MsgBox msgCap, vbInformation + vbOKOnly
 Exit Sub
 Case Is = False
 On Error Resume Next
 testStr = Dir(logWBpath)
 On Error GoTo 0
 Dim closeDate As Date
 closeDate = Sheet1.Range("P9")
 Dim logWB As Workbook
 Dim logWS As Worksheet
 Select Case Right(closeDate, 4)
 Case Is = cYear
 PopulateData logWB, logWS, ThisWorkbook, ThisWorkbook.Sheets("In-House"), cYear
 Case Is = nYear
 If testStr = "" Then
 Dim ErrMsg As String
 ErrMsg = "The QC Log for " & nYear & " may not have been created yet or has a different naming convention." & vbCrLf & vbCrLf _
 & "Please Contact Zack Elcombe." & vbCrLf & " Ext: 4519" & vbCrLf & " Email: [email protected]"
 MsgBox ErrMsg, vbCritical
 Else
 PopulateData logWB, logWS, ThisWorkbook, ThisWorkbook.Sheets("In-House"), , nYear
 End If
 Case Is = ""
 MsgBox "Closing Date is required", vbCritical + vbOKOnly
 End Select
 With Sheet1.Send
 .Locked = True
 .Enabled = False
 .BackColor = vbGreen
 End With
 End Select
End Sub
Sub PopulateData(LogWorkbook As Workbook, LogWorksheet As Worksheet, QualityContWB As Workbook, _
 QualityContWS As Worksheet, Optional ByVal CurrentYear As String, Optional ByVal NextYear As String)
 If Not CurrentYear = "" Then
 Set LogWorkbook = Workbooks.Open("L:\Loans\Quality Control\QC Log " & CurrentYear & ".xlsx", False)
 Else
 Set LogWorkbook = Workbooks.Open("L:\Loans\Quality Control\QC Log " & NextYear & ".xlsx", False)
 End If
 Set LogWorksheet = LogWorkbook.Sheets("Sheet1")
 Set QualityContWB = ThisWorkbook
 Set QualityContWS = QualityContWB.Sheets("In-House")
 Dim dataRow As Long
 dataRow = LogWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
 LogWorksheet.Range("B" & dataRow) = Format(QualityContWS.Range("P9"), "General Date")
 Select Case LCase(Split(QualityContWS.Range("lnOfficer"), " ")(0))
 Case Is = "cassie": LogWorksheet.Range("C" & dataRow) = "CLH"
 Case Is = "amy": LogWorksheet.Range("C" & dataRow) = "ASN"
 Case Is = "nancy": LogWorksheet.Range("C" & dataRow) = "NAK"
 Case Is = "liz": LogWorksheet.Range("C" & dataRow) = "EAO"
 Case Is = "rob": LogWorksheet.Range("C" & dataRow) = "RTE"
 End Select
 LogWorksheet.Range("D" & dataRow) = QualityContWS.Range("LnProcessor")
 LogWorksheet.Range("E" & dataRow) = QualityContWS.Range("BorrowerName")
 LogWorksheet.Range("F" & dataRow) = QualityContWS.Range("LnNumber")
 LogWorksheet.Range("G" & dataRow) = "No"
 Dim Reviewer As String
 If Len(QualityContWS.Range("Reviewer")) > 0 Then
 Select Case LCase(Split(QualityContWS.Range("Reviewer"), " ")(0))
 Case Is = "hunter": Reviewer = "HMP"
 Case Is = "cindy": Reviewer = "CKK"
 Case Is = "zack": Reviewer = "ZJE"
 Case Is = "terri": Reviewer = "TJE"
 End Select
 Else: Reviewer = ""
 End If
 Select Case Len(QualityContWS.Range("DateCleartoClose"))
 Case Is = 0
 LogWorksheet.Range("H" & dataRow) = Reviewer
 LogWorksheet.Range("I" & dataRow) = vbNullString
 Case Is > 1: LogWorksheet.Range("I" & dataRow) = QualityContWS.Range("DateCleartoClose")
 End Select
 Dim qcComments As String
 qcComments = QualityContWS.Range("C88") & " " & QualityContWS.Range("C89") & " " & QualityContWS.Range("C90") & " " & QualityContWS.Range("C91")
 LogWorksheet.Range("J" & dataRow) = qcComments & ". " & Reviewer
 LogWorkbook.Save
 LogWorkbook.Close
End Sub
Option Explicit
Function IsWorkBookOpen(filename As String) As Boolean
 Dim ff As Long, ErrNo As Long
 On Error Resume Next
 ff = FreeFile()
 Open filename For Input Lock Read As #ff
 Close ff
 ErrNo = Err
 On Error GoTo 0
 Select Case ErrNo
 Case 0: IsWorkBookOpen = False
 Case 70: IsWorkBookOpen = True
 Case Else: Error ErrNo
 End Select
End Function

• TinMan: What is With Sheet1.Send????
• Zack E: its an ActiveX button on the worksheet
• TinMan: That makes sense.

Answer 1

Select Case ret
 Case Is = True
 Exit Sub
 Case Is = False
End Select

I would write a Select Case that will never have more than two conditions as an If..Else statement.

In this case, I prefer to wrap the IsWorkBookOpen() in its own If statement because you are going to exit the sub if it is triggered. This will save you an indent level and eliminate the need for the ret variable.

If IsWorkBookOpen(logWBpath) Then
 Dim msgCap As String
 msgCap = "The QC Log is currently open. Please try again later or manually enter the data."
 MsgBox msgCap, vbInformation + vbOKOnly
 Exit Sub
End If

Adding white-space before and after your code blocks (e.g. If, Select, Sub, Function..) will make the code easier to read.

If Len(QualityContWS.Range("Reviewer")) > 0 Then
 Select Case LCase(Split(QualityContWS.Range("Reviewer"), " ")(0))
 Case Is = "hunter": Reviewer = "HMP"
 Case Is = "cindy": Reviewer = "CKK"
 Case Is = "zack": Reviewer = "ZJE"
 Case Is = "terri": Reviewer = "TJE"
 End Select
Else: Reviewer = ""
End If

Use with blocks to shorten references:

Before

Dim qcComments As String
qcComments = QualityContWS.Range("C88") & " " & QualityContWS.Range("C89") & " " & QualityContWS.Range("C90") & " " & QualityContWS.Range("C91")
LogWorksheet.Range("J" & dataRow) = qcComments & ". " & Reviewer

After

With QualityContWS
 LogWorksheet.Range("J" & dataRow) = WorksheetFunction.TextJoin(" ", True, .Range("C89:C91").Value, ". ", Reviewer)
End With

Good thing that these are going to be the only 4 employees who will never leave the company or you may need to rewrite a lot of code in the future. Normally, I would recommend storing the employee information in a database and writing some lookup functions or an employee information class but I am sure you will be alright.

Dim dataRow As Long
dataRow = LogWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1

I'm really not a fan of having a lastrow variable unless absolutely necessary.

As I have mentioned in answers to other questions of the OP, consider using Enumeration to reference you columns.

Public Enum LogWorksheetColumns
 cA = 1
 cDateOf
 lnOfficerInitials
 cLnProcessor
 cBorrowerName
 cLnNumber
 cYesNo
 cReviewer
 cDateCleartoClose
End Enum
Sub PopulateData(...)
 '...
 Dim newRow As Range
 With LogWorksheet
 Set newRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
 End With
 With QualityContWS
 newRow(cDateOf) = Format(.Range("P9"), "General Date")
 newRow(lnOfficerInitials) = GetLnProcessor(Split(QualityContWS.Range("lnOfficer").Value, " ")(0))
 newRow(cLnProcessor) = .Range("LnProcessor").Value
 newRow(cBorrowerName) = .Range("BorrowerName").Value
 newRow(cLnNumber) = .Range("LnNumber").Value
 newRow(cYesNo) = "No"
 newRow(cDateCleartoClose) = ....
 End With
 '...
End Sub

Rows.Count needs to be qualified to a worksheet:

LogWorksheet.Cells(LogWorksheet.Rows.Count, "B").End(xlUp).Row + 1

• Zack E: Thanks again for your great breakdown of these items. Im not familiar with the enum statement, but I will definitely research it. Looks like the laundry list of items when i submit code here is getting shorter and shorter now thanks to you. Much Appreciated! :)
• TinMan: @ZackE thanks again for accepting my answer but you may want to wait a couple of days before you accept an answer on a review. This will give others a chance to post different perspectives. Multiple reviews are good for everybody, even the reviewers.
• Zack E: good to know. I will definitely do that on future questions.