View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
JLatham JLatham is offline
external usenet poster
 
Posts: 3,365
Default PUTTING VBA'S TOGETHER

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.

"confused deejay" wrote:

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?????????
--
deejay