Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
For a website, are Excel scripts better than other programming language scripts? | Excel Programming | |||
How do I change the Row Reference from a seperate worksheet. | Excel Discussion (Misc queries) | |||
combining two short VBA scripts from two buttons | Excel Programming | |||
Change Cell from Validated List Not Firing Worksheet Change Event | Excel Programming |