Would it be possible to add some code to the orignal code in order to exapand the columns, at the moment when i case a new case entry, the caseref file opens but i have to widen the columns for dates and amounts
Also can we merge cells via code in order for me to write comments for each case ref. So i would like to merge 2 rows at a time, eg. B6:G7 with a black border, then B8:G9 with a blackborder and so on, i can send you a sample via email if you wish, so it would be easier to visualise.
First, to autofit columns you can add this Subroutine and Function to your standard module:
Code:
Sub MyAutoFitColumns(ByRef ws As Worksheet)
Dim x As Long
For x = GetLastColumn(ws) To 1 Step -1
ws.Columns(x).AutoFit
Next x
End Sub
'------------------------------------------------------
Function GetLastColumn(ByRef ws As Worksheet) As Long
'Returns number of last used column on a worksheet
GetLastColumn = ws.Cells.Find("*", [A1], xlFormulas, xlPart, _
xlByColumns, xlPrevious, False, False).Column
End Function
Then alter your code to call this sub when needed.
For instance in the routine DoubleClicked, just after these three lines:
Code:
'Try to find the sheet for the case ref by its name
On Error Resume Next
wbOpened.Worksheets(strCaseRef).Activate
You add the subroutine call so your code looks like:
Code:
'Try to find the sheet for the case ref by its name
On Error Resume Next
wbOpened.Worksheets(strCaseRef).Activate
Call MyAutoFitColumns(Worksheets(strCaseRef)) 'NEW LINE
And also in the routine SendCaseToWorkbook you add the subroutine call just after these lines:
Code:
Else 'Open an existing workbook and add a sheet
strTemp = "C:\TEMP\jamie\ref\caseref" & Arg1(2) & ".xls"
Set wb = Workbooks.Open(strTemp)
Set ws = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = strCaseRef
ws.Cells(2, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
So your code looks like:
Code:
Else 'Open an existing workbook and add a sheet
strTemp = "C:\TEMP\jamie\ref\caseref" & Arg1(2) & ".xls"
Set wb = Workbooks.Open(strTemp)
Set ws = wb.Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = strCaseRef
ws.Cells(2, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
Call MyAutoFitColumns(Worksheets(strCaseRef)) 'NEW LINE
and of course the code continues with a few more lines...
----------------------------------------------
Second, to merge cells you can use code. I'm going to take this as being an independent set of routines. This code will work on the active cell, which is basically whatever cell you are currently working in. If for instance you want to merge B6:G7 you'd need to have the active cell as B6 when you run the code. I'd suggest you assign a shortcut key, so can for instance just hit Control + Shift + M from the keyboard and the code will run...
Merged cells are in general not very easy to work with in code, so if you want to code something to work with these merged cells, it will be no fun! In fact, as I think about this, it may cause trouble trying to autofit the columns we just worked out...
Another option would be to size the column b very wide, and just use "wrap text" - this works out much the same as a merged cell in appearance. With wrapping text, you probably want some extra column width (and/or taller rows).
MERGE OPTION:
Code:
Sub MergeCellsTwoRowsSixColumns()
Dim rng As Range
Set rng = ActiveCell.Resize(2, 6)
rng.Merge
Call MyBorders(rng)
End Sub
'---------------------------------
Sub MyBorders(ByRef rng As Range)
With rng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub
Here would be the code to use wrap text and a larger cell instead.
WRAP OPTION:
Code:
Sub MyWrapTextAndExtendCellSize()
Dim rng As Range
Set rng = ActiveCell
rng.WrapText = True
rng.EntireColumn.ColumnWidth = 54.14
rng.EntireRow.RowHeight = 25.5
Call MyBorders(rng)
End Sub
--this uses same MyBorders subroutine as above. HTH!