PUTTING VBA'S TOGETHER

[confused deejay]

hiya after weeks and weeks of research, questions and many answers i've
managed to put an expense sheet together with links and other bits involved
the problem i'm having is putting the different VBA's together there's two on
two seperate pages.

the first one looks like this but doesn't work....

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Cells.EntireColumn.AutoFit
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub
-----------------------------------------------------------
the second....
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Cells.EntireColumn.AutoFit
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
'If Target.Address = "$A$1" Then
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Range("IV" & Target.Row).End(xlToLeft).Offset(, 1).Value = Date
Range("IV" & Target.Row).End(xlToLeft).Offset(, 1).Value = Time
Application.EnableEvents = True
On Error GoTo 0
End If
End Sub

can anyone tell me what i'm doing wrong pleeeeeeeeeeeease?????????

 

[JLatham]

While each worksheet can have a Worksheet_Change() event, each can only have
one. You've got multiple _Change() events fighting for attention in both
sheets.

Since, at least on the second sheet for sure, you intend for each different
routine to work with different areas of the worksheet, we need to know what
areas (entire single column, part of a column as A1:A100, or over multiple
columns) the codes on each sheet are intended to work with. Then it will
need to all be brought into a single Worksheet_Change() event for each
worksheet, with some Intersect() testing used to tell which parts of it
should work when different cells are chosen on the worksheet.

 

[JLatham]

This might work to replace the two pieces for the first sheet. I'm still
looking at the 3 for the second sheet.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next

ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0

Else
Cells.EntireColumn.AutoFit
End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[JLatham]

This might work to replace all of the code you have for that second
worksheet. Since I really don't have insight into when you want to do what
on either sheet, both of these combined code piecses (this one and one above)
are just my best guess and may not meet your exact needs.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next

ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0

ElseIf Not Intersect(Target, Range("A1:A100")) Is Nothing Then

If Target.Cells.Count = 1 And Not IsEmpty(Target) Then
On Error Resume Next
Application.EnableEvents = False
Range("IV" & Target.Row).End(xlToLeft).Offset(, 1).Value = Date
Range("IV" & Target.Row).End(xlToLeft).Offset(, 1).Value = Time
Application.EnableEvents = True
On Error GoTo 0
End If

Else

Cells.EntireColumn.AutoFit

End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[Harlan Grove]

the first one looks like this but doesn't work....

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Cells.EntireColumn.AutoFit
    Application.EnableEvents = True
End Sub

Autofitting column widths doesn't trigger any events, so no need to
bracket it between disabling and enabling event statements.

Private Sub Worksheet_Change(ByVal Target As Range) ....
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
       MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
     ma.MergeCells = False
     c.ColumnWidth = MrgeWdth
     c.EntireRow.AutoFit
     NewRwHt = c.RowHeight
     c.ColumnWidth = cWdth
     ma.MergeCells = True
    ma.RowHeight = NewRwHt
    cWdth = 0: MrgeWdth = 0

You will come to regret using colons to pack multiple statements into
a single line. It was a usful performance hack back in BASICA days
when passing as few lines as possible to the interpreter was a good
thing, but it does nothing but reduce readability in compiled BASIC.

Application.ScreenUpdating = True
End If
End With
End Sub

You've come across the problem that Excel ignores merged cells when
autofitting column widths. This is more a problem with autofitting
than with merged cells. There's seldom a good reason to autofit
everything. There's never a good reason to autofit everything when you
change just one cell.

All you need to autofit is the columns containing the current entry.
To handle merged cells in different rows in the same column(s) as the
entry, all you need to do is undo autofitting if the column widths
shrink. That would mean the Change event handler could only increase
column widths. Decreasing column widths without shrinking merged cells
across multiple columns too much would probably best be left to a
separate macro. The idea there would be storing the MINIMUM widths of
the individual columns, so if autofitting set some column widths
narrow than the minimum widths, the macro would widen those columns to
their minimum widths.

So, if columns C through H have respective minimum widths 4, 5, 6, 7,
8 and 9, I define the names MinWidths referring to ={4,5,6,7,8,9} and
AutofitRange referring to C5:H24. Then I use a change event handler
like the following.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, minwidths As Variant, autofitrange As Range

Set autofitrange = ThisWorkbook.Names("AutofitRange").RefersToRange

'return quickly when changes are made outside the range in question
If Intersect(Target, autofitrange) Is Nothing Then Exit Sub

'use error traps to reset Application settings
On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False

'autofit only the columns in the range in question
Intersect(Target.EntireColumn, autofitrange).Columns.AutoFit

minwidths = Evaluate("MinWidths")

'check whether column widths are too narrow, and if so, set them to
minimums
'also do this when whole columns are effectively blank
With Application.WorksheetFunction
For i = 1 To UBound(minwidths)
If autofitrange.Cells(1, i).ColumnWidth < minwidths(i) Or _
.CountIf(autofitrange.Columns(i), "<>") = 0 Then _
autofitrange.Cells(1, i).ColumnWidth = minwidths(i)
Next i
End With

CleanUp:
Application.EnableCancelKey = xlInterrupt
Application.ScreenUpdating = True

End Sub

 

[confused deejay]

thank you guys this information was fantastic i've managed to get my work
complete after weks of pain lol