Option Explicit
Sub CallDoubleClicked()
'Test sub
Call DoubleClicked(Range(Cells(2, 1), Cells(2, 6)), "AMP17")
End Sub
Sub DoubleClicked(rngCase As Range, strCaseRef As String)
'DoubleClick Event to send the range to copy and the case reference to this sub
Dim strPath As String
Dim x As Long
Dim arrIndex() As Variant
Dim RefElements As Variant
Dim mainWb As Workbook
Dim blnFound As Boolean
'reference original workbook and get index into an array
Set mainWb = ActiveWorkbook
arrIndex = Worksheets("MyIndex").Cells(1, 1).CurrentRegion.Value
'Find out if case reference already exists (look in first dimension of array)
x = 1
Do While x < UBound(arrIndex, 1)
If strCaseRef = arrIndex(x, 1) Then
blnFound = True
Exit Do
End If
x = x + 1
Loop
'If case reference exists, then open the file (path is in second dimension of array)
If blnFound Then
Workbooks.Open (arrIndex(x, 2))
Else
'Get Array with highest existing CaseRef Number and whether a new workbook is needed
RefElements = CaseRefElements(arrIndex)
'Write to a new workbook or to an existing workbook as needed
Call SendCaseToWorkbook(RefElements, rngCase, strCaseRef)
'Create a new Index Record
Call WriteToIndex(mainWb, RefElements, strCaseRef)
End If
End Sub
'-----------------------------------------------------------------
Private Function CaseRefElements(arrIndex) As Variant
Dim intMax As Integer
Dim intHighestCase As Integer
Dim blnNewWorkbook As Boolean
Dim i As Long
'LOGIC ERROR - DOESN'T GET FOR ME THE WORKBOOK NAME - written as if
'The case ref was the workbook name. Needs another entry in the index
intHighestCase = 1 'Case Number within Workbooks
For i = 1 To UBound(arrIndex, 1)
If arrIndex(i, 3) > intHighestCase Then
intHighestCase = arrIndex(i, 3)
End If
Next i
If intHighestCase Mod 50 = 0 Then 'Multiple of 50
intMax = intMax + 1 'Start a new workbook
blnNewWorkbook = True
End If
CaseRefElements = Array(intHighestCase, blnNewWorkbook)
End Function
'-----------------------------------------------------------------
Private Sub SendCaseToWorkbook(Arg1 As Variant, myRange As Range, strCase As String)
Dim a As Variant
Dim wb As Workbook
Dim ws As Worksheet
Dim strTemp As String
Dim msg As String
Dim ans As String
a = myRange.Value
If Arg1(1) Then 'Start a new workbook
Set wb = Workbooks.Add
wb.Worksheets(1).Cells(2, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
strTemp = "C:\TEMP\jamie\ref\caseref" & Arg1(0) + 1 & ".xls"
wb.SaveAs strTemp
msg = "Save and close workbook now?"
ans = MsgBox(msg, vbYesNo)
If ans = vbYes Then wb.Close SaveChanges:=True
Else 'Open an existing workbook and add a sheet
strTemp = "C:\TEMP\jamie\ref\caseref" & Arg1(0) & ".xls"
Set wb = Workbooks.Open(strTemp)
Set ws = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = strCase
ws.Cells(2, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
msg = "Save and close workbook now?"
ans = MsgBox(msg, vbYesNo)
If ans = vbYes Then wb.Close SaveChanges:=True
End If
End Sub
'-----------------------------------------------------------------
Private Sub WriteToIndex(wb As Workbook, RefElements, strCaseRef)
Dim ws As Worksheet
Dim LRow As Long
Dim strTemp As String
'LOGIC ERROR - index has Case Ref, Full Path, and Case Ref Integer portion
'Needs a column for the workbook Integer portion.
Set ws = wb.Worksheets("MyIndex")
LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(LRow + 1, 1).Value = RefElements(0) 'CaseRef
strTemp = "C:\TEMP\jamie\ref\caseref" & RefElements(1) + 1 & ".xls" 'FullPath
ws.Cells(LRow + 1, 2).Value = strTemp 'FullPath
ws.Cells(LRow + 1, 4).Value = strCaseRef 'CaseRef Number
End Sub