ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help with combining 2 seperate Worksheet Change Event scripts (https://www.excelbanter.com/excel-programming/441654-help-combining-2-seperate-worksheet-change-event-scripts.html)

GoBucks[_2_]

Help with combining 2 seperate Worksheet Change Event scripts
 
Hi,

I have 2 seperate Worksheet Change Event scripts that I would like to
combine to use in one woeksheet and I'm sure how to do. I am kind of new to
VB.

The first script is for hiding columns based on a value selected in picklist.

Private Sub Worksheet_Change(ByVal Target As Range) 'SalesAid Software
If Target.Address < Range("L2").Address Then Exit Sub
'MsgBox Month(Target)
If Target = "All" Then
Range("N:BV").EntireColumn.Hidden = False
Else
lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
mr = Range("L2")
'MsgBox mr
ff = mr - Weekday(mr - 6) + 7
'MsgBox ff
fc = Application.Match(CLng(ff), Rows("6:6"), 0)
'MsgBox fc

lf = DateSerial(Year(mr), Month(mr) + 3, 1) -
Weekday(DateSerial(Year(mr), Month(mr) + 3, 2))
'MsgBox lf
lc = Application.Match(CLng(lf), Rows("6:6"))
'MsgBox lc

Columns(14).Resize(, lastcol).Hidden = True
Range(Cells(6, fc), Cells(6, lc)).EntireColumn.Hidden = False
End If

End Sub

Sub SAS_UnhideAllColumns()
Columns.Hidden = False
End Sub

The second script is for copying values to a range left of a cell being input.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Application.Intersect(Target, Range("L7:BL206")) Is Nothing Then Exit
Sub
On Error Resume Next
Application.EnableEvents = False
Range("K" & Target.Row, Target).SpecialCells(xlCellTypeBlanks).Value =
Target.Value
Application.EnableEvents = True
On Error Goto 0
End Sub


Thank you in advance for your help.

Rick Rothstein

Help with combining 2 seperate Worksheet Change Event scripts
 
See if this Change event code works for you (note that this replaces
**only** the two Change event procedures you posted and not anything else,
including the SAS_UnhideAllColumns subroutine that you also posted for some
reason)...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Application.Intersect(Target, Range("L7:BL206")) Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Range("K" & Target.Row, Target).SpecialCells( _
xlCellTypeBlanks).Value = Target.Value
Application.EnableEvents = True
On Error GoTo 0
ElseIf Target.Address = Range("L2").Address Then
'MsgBox Month(Target)
If Target = "All" Then
Range("N:BV").EntireColumn.Hidden = False
Else
lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
mr = Range("L2")
'MsgBox mr
ff = mr - Weekday(mr - 6) + 7
'MsgBox ff
fc = Application.Match(CLng(ff), Rows("6:6"), 0)
'MsgBox fc

lf = DateSerial(Year(mr), Month(mr) + 3, 1) - Weekday( _
DateSerial(Year(mr), Month(mr) + 3, 2))
'MsgBox lf
lc = Application.Match(CLng(lf), Rows("6:6"))
'MsgBox lc

Columns(14).Resize(, lastcol).Hidden = True
Range(Cells(6, fc), Cells(6, lc)).EntireColumn.Hidden = False
End If
End If
End Sub

--
Rick (MVP - Excel)



"GoBucks" wrote in message
...
Hi,

I have 2 seperate Worksheet Change Event scripts that I would like to
combine to use in one woeksheet and I'm sure how to do. I am kind of new
to
VB.

The first script is for hiding columns based on a value selected in
picklist.

Private Sub Worksheet_Change(ByVal Target As Range) 'SalesAid Software
If Target.Address < Range("L2").Address Then Exit Sub
'MsgBox Month(Target)
If Target = "All" Then
Range("N:BV").EntireColumn.Hidden = False
Else
lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
mr = Range("L2")
'MsgBox mr
ff = mr - Weekday(mr - 6) + 7
'MsgBox ff
fc = Application.Match(CLng(ff), Rows("6:6"), 0)
'MsgBox fc

lf = DateSerial(Year(mr), Month(mr) + 3, 1) -
Weekday(DateSerial(Year(mr), Month(mr) + 3, 2))
'MsgBox lf
lc = Application.Match(CLng(lf), Rows("6:6"))
'MsgBox lc

Columns(14).Resize(, lastcol).Hidden = True
Range(Cells(6, fc), Cells(6, lc)).EntireColumn.Hidden = False
End If

End Sub

Sub SAS_UnhideAllColumns()
Columns.Hidden = False
End Sub

The second script is for copying values to a range left of a cell being
input.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Application.Intersect(Target, Range("L7:BL206")) Is Nothing Then
Exit
Sub
On Error Resume Next
Application.EnableEvents = False
Range("K" & Target.Row, Target).SpecialCells(xlCellTypeBlanks).Value =
Target.Value
Application.EnableEvents = True
On Error Goto 0
End Sub


Thank you in advance for your help.



GoBucks[_2_]

Help with combining 2 seperate Worksheet Change Event scripts
 
Thanks Rick! That did the trick!

"Rick Rothstein" wrote:

See if this Change event code works for you (note that this replaces
**only** the two Change event procedures you posted and not anything else,
including the SAS_UnhideAllColumns subroutine that you also posted for some
reason)...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Application.Intersect(Target, Range("L7:BL206")) Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Range("K" & Target.Row, Target).SpecialCells( _
xlCellTypeBlanks).Value = Target.Value
Application.EnableEvents = True
On Error GoTo 0
ElseIf Target.Address = Range("L2").Address Then
'MsgBox Month(Target)
If Target = "All" Then
Range("N:BV").EntireColumn.Hidden = False
Else
lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
mr = Range("L2")
'MsgBox mr
ff = mr - Weekday(mr - 6) + 7
'MsgBox ff
fc = Application.Match(CLng(ff), Rows("6:6"), 0)
'MsgBox fc

lf = DateSerial(Year(mr), Month(mr) + 3, 1) - Weekday( _
DateSerial(Year(mr), Month(mr) + 3, 2))
'MsgBox lf
lc = Application.Match(CLng(lf), Rows("6:6"))
'MsgBox lc

Columns(14).Resize(, lastcol).Hidden = True
Range(Cells(6, fc), Cells(6, lc)).EntireColumn.Hidden = False
End If
End If
End Sub

--
Rick (MVP - Excel)



"GoBucks" wrote in message
...
Hi,

I have 2 seperate Worksheet Change Event scripts that I would like to
combine to use in one woeksheet and I'm sure how to do. I am kind of new
to
VB.

The first script is for hiding columns based on a value selected in
picklist.

Private Sub Worksheet_Change(ByVal Target As Range) 'SalesAid Software
If Target.Address < Range("L2").Address Then Exit Sub
'MsgBox Month(Target)
If Target = "All" Then
Range("N:BV").EntireColumn.Hidden = False
Else
lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
mr = Range("L2")
'MsgBox mr
ff = mr - Weekday(mr - 6) + 7
'MsgBox ff
fc = Application.Match(CLng(ff), Rows("6:6"), 0)
'MsgBox fc

lf = DateSerial(Year(mr), Month(mr) + 3, 1) -
Weekday(DateSerial(Year(mr), Month(mr) + 3, 2))
'MsgBox lf
lc = Application.Match(CLng(lf), Rows("6:6"))
'MsgBox lc

Columns(14).Resize(, lastcol).Hidden = True
Range(Cells(6, fc), Cells(6, lc)).EntireColumn.Hidden = False
End If

End Sub

Sub SAS_UnhideAllColumns()
Columns.Hidden = False
End Sub

The second script is for copying values to a range left of a cell being
input.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Application.Intersect(Target, Range("L7:BL206")) Is Nothing Then
Exit
Sub
On Error Resume Next
Application.EnableEvents = False
Range("K" & Target.Row, Target).SpecialCells(xlCellTypeBlanks).Value =
Target.Value
Application.EnableEvents = True
On Error Goto 0
End Sub


Thank you in advance for your help.


.



All times are GMT +1. The time now is 07:17 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com