I've coded myself into a corner!
I take cells from Main after filtering and copy to Main2 using "wsM.Columns("bm:bm").Copy .Range("j1")"
The problem comes when I move a column or insert a new one on "Main" sheet. I got around it on another sheet by using MATCH =VLOOKUP($A2,Main!$B$2:$IV$397,MATCH(Main!E1,Main!$1:$1,0)-1,FALSE)
Is there a way of inserting match into the range to make sure I first search for the correct column title (row main!A1) before copying it.
Perhaps there's a quicker way?
Thanks.
Dim Dept As String
Dim wsM As Worksheet, wsM2 As Worksheet
Dim LRow2 As String
Private Sub BakeryData()
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
With wsM2
'Dept Specific
wsM.Columns("bm:bm").Copy .Range("j1")
wsM.Columns("bn:bn").Copy .Range("k1")
wsM.Columns("bo:bo").Copy .Range("l1")
wsM.Columns("bp:bp").Copy .Range("m1")
'auto fit titles
.Rows(1).AutoFit
End With
End Sub
Private Sub CB_Bakery_Click()
Application.ScreenUpdating = False ' turns off screen refreshing.
Dept = "Bakery"
'sets the variables wsM equal to Main worksheet and wsM2 equal to Main2
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
LRow2 = 0
'reset main
Sheets("main").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
'select the Main2 worksheet
With wsM2
wsM2.UsedRange.Clear
'filter Dept
wsM.UsedRange.AutoFilter Field:=3, Criteria1:=Dept
wsM.Columns("b:b").Copy .Range("a1")
wsM.Columns("d:d").Copy .Range("b1")
wsM.Columns("f:f").Copy .Range("c1")
wsM.Columns("q:q").Copy .Range("e1")
wsM.Columns("r:r").Copy .Range("g1")
wsM.Columns("g:g").Copy .Range("h1")
'Dim DeptData As String
'DeptData = Dept & "Data"
Call BakeryData
Call Think25
Call Fire
Call CPRs
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Sheets("main2").Select
Application.ScreenUpdating = True ' turns back on screen refreshing.
End With
End Sub
Private Sub Think25()
'sets the variables wsM equal to Main worksheet and wsM2 equal to Main2
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
'sets variable LRow2 equal to the last row in column A of the
'activesheet that contains data
LRow2 = wsM2.Cells(wsM2.Rows.Count, "A").End(xlUp).Row
' Set D column Due for Think 25
'put a value in column D cell D1
wsM2.Range("D1").Value = "Due"
'value in D2 equal to the formula
'copy the formula
wsM2.Range("D2:D" & LRow2).Formula = "=c2-(TODAY()-182)"
'set conditional formating
With wsM2.Range("D2:D" & LRow2)
.FormatConditions.Delete
'.Range("d2,d" & LRow2).NumberFormat = "0"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="30"
.FormatConditions(1).Font.ColorIndex = 15
.FormatConditions(1).Interior.ColorIndex = 2
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="1", Formula2:="30"
.FormatConditions(2).Font.ColorIndex = 2
.FormatConditions(2).Interior.ColorIndex = 37
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=TODAY()-182"
.FormatConditions(3).Font.ColorIndex = 2
.FormatConditions(3).Interior.ColorIndex = 9
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Private Sub Fire()
'sets the variables wsM equal to Main worksheet and wsM2 equal to Main2
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
'sets variable LRow2 equal to the last row in column A of the
'activesheet that contains data
LRow2 = wsM2.Cells(wsM2.Rows.Count, "A").End(xlUp).Row
' Set F Column Due for Fire
'put a value in column D cell D1
wsM2.Range("f1").Value = "Due"
'value in f2 equal to the formula
'copy the formula
wsM2.Range("f2:f" & LRow2).Formula = "=e2-(TODAY()-365)"
'set conditional formating
With wsM2.Range("f2:f" & LRow2)
.FormatConditions.Delete
.Range("f2,f" & LRow2).NumberFormat = "0"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="30"
.FormatConditions(1).Font.ColorIndex = 15
.FormatConditions(1).Interior.ColorIndex = 2
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="1", Formula2:="30"
.FormatConditions(2).Font.ColorIndex = 2
.FormatConditions(2).Interior.ColorIndex = 37
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=TODAY()-365"
.FormatConditions(3).Font.ColorIndex = 2
.FormatConditions(3).Interior.ColorIndex = 9
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Private Sub CPRs()
'sets the variables wsM equal to Main worksheet and wsM2 equal to Main2
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
'sets variable LRow2 equal to the last row in column A of the
'activesheet that contains data
LRow2 = wsM2.Cells(wsM2.Rows.Count, "A").End(xlUp).Row
' Set I Column Due for CPrs
'put a value in column D cell D1
wsM2.Range("i1").Value = "Due"
'value in i2 equal to the formula
'copy the formula
wsM2.Range("i2:i" & LRow2).Formula = "=h2-(TODAY()-182)"
'set conditional formating
With wsM2.Range("i2:i" & LRow2)
.FormatConditions.Delete
.Range("i2,i" & LRow2).NumberFormat = "0"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="30"
.FormatConditions(1).Font.ColorIndex = 15
.FormatConditions(1).Interior.ColorIndex = 2
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="1", Formula2:="30"
.FormatConditions(2).Font.ColorIndex = 2
.FormatConditions(2).Interior.ColorIndex = 37
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=TODAY()-182"
.FormatConditions(3).Font.ColorIndex = 2
.FormatConditions(3).Interior.ColorIndex = 9
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'set widths
wsM2.Columns("A:A").ColumnWidth = 15
wsM2.Columns("B:B").ColumnWidth = 12
wsM2.Range("C:C,E:E").ColumnWidth = 7.5
wsM2.Columns("D:D").ColumnWidth = 4
wsM2.Columns("F:F").ColumnWidth = 4
wsM2.Range("G:G,H:H").ColumnWidth = 7.5
wsM2.Columns("I:I").ColumnWidth = 4
wsM2.Range("J:J,K:K,L:L,M:M").ColumnWidth = 7.5
'.Columns("F:F").EntireColumn.AutoFit
End Sub
Private Sub CB_ChooseTraining_Click()
ChooseT.Show
End Sub
Private Sub CB_DevPlans_Click()
'sets the variables wsM equal to Main worksheet and wsM2 equal to Main2
Set wsM = Sheets("Main")
Set wsM2 = Sheets("Main2")
LRow2 = 0
'reset main
Application.ScreenUpdating = False ' Prevents screen refreshing.
Sheets("main").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
'select the Main2 worksheet
With wsM2
wsM2.UsedRange.Clear
'select all the cells
wsM.UsedRange.AutoFilter Field:=4, Criteria1:="=Manager", Operator:=xlOr, _
Criteria2:="=Team Leader"
wsM.Columns("b:b").Copy .Range("a1")
wsM.Columns("d:d").Copy .Range("b1")
wsM.Columns("fb:fb").Copy .Range("c1")
wsM.Columns("et:et").Copy .Range("d1")
wsM.Columns("er:er").Copy .Range("e1")
wsM.Columns("es:es").Copy .Range("f1")
wsM.Columns("eu:eu").Copy .Range("g1")
wsM.Columns("ev:ev").Copy .Range("h1")
wsM.Columns("ew:ew").Copy .Range("i1")
wsM.Columns("ex:ex").Copy .Range("j1")
wsM.Columns("ey:ey").Copy .Range("k1")
wsM.Columns("ez:ez").Copy .Range("l1")
'sets variable LRow2 equal to the last row in column A of the
'activesheet that contains data
LRow2 = wsM2.Cells(wsM2.Rows.Count, "A").End(xlUp).Row
'set widths
.Columns("A:A").ColumnWidth = 15
.Columns("B:B").ColumnWidth = 12
.Range("C:M").ColumnWidth = 9.2
.Rows(1).AutoFit
'.Columns("F:F").EntireColumn.AutoFit
End With
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Sheets("main2").Select
End Sub
Bookmarks