mercmannick
07-15-2005, 10:12 AM
:banghead:
Sub Zflex_For_Customer()
Application.ScreenUpdating = False
Range("E6").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E6:Q90").Select
Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("D6").Select
ActiveCell.FormulaR1C1 = "=RC[2]"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],"""",RC[2])"
Range("D7").Select
Selection.AutoFill Destination:=Range("D7:D150"), Type:=xlFillDefault
'Range("D7:D150").Select
Range("F4").Copy
'Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Range("R6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",IF(RC[-1]="""",1,0),0)"
Range("R6").Select
Selection.AutoFill Destination:=Range("R6:R255"), Type:=xlFillDefault
Range("R6:R255").Select
With ActiveWindow
.DisplayGridlines = False
.DisplayZeros = False
End With
Range("D6:R6").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$O6=0"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(1).Interior.ColorIndex = 4
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$R6=1"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 6
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
ActiveWindow.SmallScroll ToRight:=8
Selection.AutoFill Destination:=Range("D6:R339"), Type:=xlFillFormats
Range("D6:Q339").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("D4:Q4").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.ColorIndex = 6
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Columns("R:R").Select
Selection.EntireColumn.Hidden = True
Columns("A:Q").EntireColumn.AutoFit
Columns("B:C").Select
Selection.EntireColumn.Hidden = True
Range("F4").Select
Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Range("I2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("I2").Select
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 18
.ColorIndex = 5
End With
Dim myBottom As String
'Set active print range.
'Find bottom of page, set print range.
Sheets("zflexdetails").Range("B1:" & [B65536].End(xlUp).Offset(0, 17).Address).Select
myBottom = Selection.Address
ActiveSheet.PageSetup.PrintArea = myBottom
'Print active range.
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Can anyone show me the correct way to only format as far as Required , Reason being that sheet changes daily size wise (allways same format)
Merc
Sub Zflex_For_Customer()
Application.ScreenUpdating = False
Range("E6").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E6:Q90").Select
Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("D6").Select
ActiveCell.FormulaR1C1 = "=RC[2]"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],"""",RC[2])"
Range("D7").Select
Selection.AutoFill Destination:=Range("D7:D150"), Type:=xlFillDefault
'Range("D7:D150").Select
Range("F4").Copy
'Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Range("R6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",IF(RC[-1]="""",1,0),0)"
Range("R6").Select
Selection.AutoFill Destination:=Range("R6:R255"), Type:=xlFillDefault
Range("R6:R255").Select
With ActiveWindow
.DisplayGridlines = False
.DisplayZeros = False
End With
Range("D6:R6").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$O6=0"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(1).Interior.ColorIndex = 4
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$R6=1"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 6
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
ActiveWindow.SmallScroll ToRight:=8
Selection.AutoFill Destination:=Range("D6:R339"), Type:=xlFillFormats
Range("D6:Q339").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("D4:Q4").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.ColorIndex = 6
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Columns("R:R").Select
Selection.EntireColumn.Hidden = True
Columns("A:Q").EntireColumn.AutoFit
Columns("B:C").Select
Selection.EntireColumn.Hidden = True
Range("F4").Select
Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Range("I2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("I2").Select
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 18
.ColorIndex = 5
End With
Dim myBottom As String
'Set active print range.
'Find bottom of page, set print range.
Sheets("zflexdetails").Range("B1:" & [B65536].End(xlUp).Offset(0, 17).Address).Select
myBottom = Selection.Address
ActiveSheet.PageSetup.PrintArea = myBottom
'Print active range.
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Can anyone show me the correct way to only format as far as Required , Reason being that sheet changes daily size wise (allways same format)
Merc