drawworkhome
11-21-2009, 08:55 AM
hi all,
i have a range (b5:b30) that contains string values.
what i want to do is run a sub when a user switches from sheet("est") to a different sheet. i called that sub (checkrange) from the sheet deactivate event and it ends up being recursive.
any ideas are welcome!!
erik
:dunno
code:/
Public Sub Worksheet_Deactivate()
Call ThisWorkbook.checkrange
End Sub
end code:/
----------------------------------------
Sub checkrange()
Dim a As String
Dim b As String
Dim C As String
'Application.Visible = False
Sheet1.Activate
Columns("s:v").ClearContents
Application.ScreenUpdating = False
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:b30,a54:b54").Copy
Range("s1").Select
ActiveSheet.Paste
Range("s1:t" & lrow).SpecialCells(xlCellTypeBlanks).Delete
With Selection
.SpecialCells(xlCellTypeBlanks).Delete
x = .Count
End With
With Selection
For p = 1 To x
C = LCase(Cells(p, "t").Value)
Cells(p, "t").Value = C
Next p
End With
'Sheet1.Visible = xlSheetVisible
Sheets("est").Range("u1").Select
Range("u1").ListNames
lrow = Selection.Cells(Rows.Count, 1).End(xlUp).Row
Range("u1:v" & lrow).Select
With Selection
For Z = 1 To lrow
If InStr(LCase(Cells(Z, "v").Value), LCase("job")) = 0 Then
Cells(Z, "u").Value = ""
Cells(Z, "v").Value = ""
Else
' Z = Z + 1
End If
Next
End With
With Selection
.SpecialCells(xlCellTypeBlanks).Delete
x = .Count / 2
End With
With Selection
For y = 1 To x
Cells(y, "v").Replace What:="='job cost'!$", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells(y, "v").Replace What:=":$*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End With
Range("U1:V15").Select
Range("V15").Activate
ActiveWorkbook.Worksheets("est").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("est").Sort.SortFields.Add Key:=Range("V1:V15"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("est").Sort
.SetRange Range("U1:V15")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("S1:V15").Select
Range("V15").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlLeft
End With
With ActiveSheet
For i = 1 To x
If Cells(i, "t").Value = "" Then
Application.ScreenUpdating = True
MsgBox ("Please ensure all necessary text is in est list")
GoTo finish
End If
If Cells(i, "u").Value = "" Then
Application.ScreenUpdating = True
MsgBox ("A Named Range name is missing from sheet 2!")
GoTo finish
End If
If Cells(i, "t").Value <> Cells(i, "u").Value Then
a = Cells(i, "t").Value 'a=name to check
u = Cells(i, "u").Value 'u=name to keep
If IsNumeric(a) Or IsNumeric(u) = True Then
Application.ScreenUpdating = True
MsgBox ("Values must be text!!")
GoTo finish
End If
Names(u).Name = a 'adds new named range
Sheet1.Cells(i, "u").Value = a
End If
Next
End With
Sheet4.Range("a1").Activate
finish:
'Sheet1.Visible = xlSheetHidden
Application.Visible = True
Application.ScreenUpdating = True
'MsgBox ("Done updating")
Range("S1:V15").ClearContents
End Sub
i have a range (b5:b30) that contains string values.
what i want to do is run a sub when a user switches from sheet("est") to a different sheet. i called that sub (checkrange) from the sheet deactivate event and it ends up being recursive.
any ideas are welcome!!
erik
:dunno
code:/
Public Sub Worksheet_Deactivate()
Call ThisWorkbook.checkrange
End Sub
end code:/
----------------------------------------
Sub checkrange()
Dim a As String
Dim b As String
Dim C As String
'Application.Visible = False
Sheet1.Activate
Columns("s:v").ClearContents
Application.ScreenUpdating = False
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:b30,a54:b54").Copy
Range("s1").Select
ActiveSheet.Paste
Range("s1:t" & lrow).SpecialCells(xlCellTypeBlanks).Delete
With Selection
.SpecialCells(xlCellTypeBlanks).Delete
x = .Count
End With
With Selection
For p = 1 To x
C = LCase(Cells(p, "t").Value)
Cells(p, "t").Value = C
Next p
End With
'Sheet1.Visible = xlSheetVisible
Sheets("est").Range("u1").Select
Range("u1").ListNames
lrow = Selection.Cells(Rows.Count, 1).End(xlUp).Row
Range("u1:v" & lrow).Select
With Selection
For Z = 1 To lrow
If InStr(LCase(Cells(Z, "v").Value), LCase("job")) = 0 Then
Cells(Z, "u").Value = ""
Cells(Z, "v").Value = ""
Else
' Z = Z + 1
End If
Next
End With
With Selection
.SpecialCells(xlCellTypeBlanks).Delete
x = .Count / 2
End With
With Selection
For y = 1 To x
Cells(y, "v").Replace What:="='job cost'!$", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells(y, "v").Replace What:=":$*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End With
Range("U1:V15").Select
Range("V15").Activate
ActiveWorkbook.Worksheets("est").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("est").Sort.SortFields.Add Key:=Range("V1:V15"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("est").Sort
.SetRange Range("U1:V15")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("S1:V15").Select
Range("V15").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlLeft
End With
With ActiveSheet
For i = 1 To x
If Cells(i, "t").Value = "" Then
Application.ScreenUpdating = True
MsgBox ("Please ensure all necessary text is in est list")
GoTo finish
End If
If Cells(i, "u").Value = "" Then
Application.ScreenUpdating = True
MsgBox ("A Named Range name is missing from sheet 2!")
GoTo finish
End If
If Cells(i, "t").Value <> Cells(i, "u").Value Then
a = Cells(i, "t").Value 'a=name to check
u = Cells(i, "u").Value 'u=name to keep
If IsNumeric(a) Or IsNumeric(u) = True Then
Application.ScreenUpdating = True
MsgBox ("Values must be text!!")
GoTo finish
End If
Names(u).Name = a 'adds new named range
Sheet1.Cells(i, "u").Value = a
End If
Next
End With
Sheet4.Range("a1").Activate
finish:
'Sheet1.Visible = xlSheetHidden
Application.Visible = True
Application.ScreenUpdating = True
'MsgBox ("Done updating")
Range("S1:V15").ClearContents
End Sub