Home |
Search |
Today's Posts |
#9
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks for your help.. I give this a try
"john" wrote: sorry, but do not have time to digest all your code. can only suggest that you try changing this part With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'to this Dim NewBook As Workbook Set NewBook = ActiveWorkbook With NewBook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With ' if Worksheets("untitled") does not exist in new workbook 'then refer to it by its index number e.g. With NewBook Set ws1 = .Worksheets(1) Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'where worksheet(1) would be the first worksheet in the workbook You would call the DeleteData procedure at the point in your code just after you have made the copy of the worksheets. Copy action creates a new workbook and thus, it becomes the active workbook so this line Set NewBook = ActiveWorkbook will ensure that you are referring to the correct workbook in your code. As an aside, it is considered good practice to qualify the ranges to their respective workbook / worksheets. By doing this you can refer to them without the need to use SELECT or ACTIVATE in your code. But more importantly, you will ensure that your data ends up in the right place. The use of Range on its own can give rise to unpredictable results. You may also want to consider breaking your code down in to more manageable modules to do specific functions like DeleteData code I provided. You code would then, be much easier to read & debug. -- jb "Peruanos72" wrote: ' BEGIN FINAL UPDATE!!! Row = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row For Temp = Row To 4 Step -1 If Len(Trim(Range("E" & Temp))) < 16 Then Rows(Temp).Delete End If Next Range("A4").Select Sheets(Array("bzv", "kpx", "uco", "hvu", "generic", "bnl", "eca", "fus", "och", "rkk", "hbg", "lmp", "nfh")).Delete If Range("A4") = "" Then 'Workbooks("bluecard_homeplanaid_Master").Activate MsgBox ("There is no data for today." & vbNewLine & _ "Be sure to save this file even though no data exists") Dim ans14 As Long ans14 = MsgBox("Is today Monday?", vbYesNo + vbQuestion + vbDefaultButton2, "Report Date Confirmation") If ans14 = vbYes Then Range("rep_date") = Date - 3 Range("date") = Date Range("rep_date").Select Selection.NumberFormat = "mm.dd.yy" ActiveSheet.Name = "Bluecard_homeplanaid_" & Range("B2").Text Range("rep_date").NumberFormat = "mm/dd/yyyyy" Else Range("rep_date") = Date - 1 Range("date") = Date Range("rep_date").Select Selection.NumberFormat = "mm.dd.yy" ActiveSheet.Name = "Bluecard_homeplanaid_" & Range("B2").Text Range("rep_date").NumberFormat = "mm/dd/yyyyy" End If ' Delete Button ActiveSheet.Shapes("Button 1").Select Selection.Delete ActiveSheet.Shapes("Button 3").Select Selection.Delete ActiveSheet.Shapes("Button 4").Select Selection.Delete ActiveSheet.Shapes("Picture 2").Select Selection.Delete Range("A4").Select ' add subtotal Rows("3:3").Select Selection.Insert Shift:=xlDown Range("A3").Select ActiveCell.FormulaR1C1 = "Total:" Range("B3").Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R[2]C[2]:R[65000]C[2])" Range("B3").Select Selection.NumberFormat = "#,##0" With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With ' Add "There is no data for today's report" on excel tab Range("A5:I9").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With With Selection.Font .Name = "Century Schoolbook" .FontStyle = "Regular" .Size = 18 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ColorIndex = 3 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ActiveCell.FormulaR1C1 = "NO DATA FOR TODAY'S REPORT" Range("B1").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowDeletingRows:=True, AllowFiltering:=True ' Backup file???? Dim ans_bu As Long ans_bu = MsgBox("Backup Bluecard Homeplanaid?", vbYesNoCancel + vbDefaultButton2, "Backup File?") If ans_bu = vbYes Then Workbooks("bluecard_homeplanaid_Master").Activate ' remove color from all tabs Sheets(Array("bzv", "kpx", "uco", "hvu", "generic", "bnl", "eca", "fus", "och", "rkk", "hbg", "lmp", "nfh")).Select Sheets("generic").Activate ActiveWorkbook.Sheets("generic").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("nfh").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("bnl").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("hvu").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("uco").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("kpx").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("bzv").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("eca").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("fus").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("och").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("hbg").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("rkk").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("lmp").Tab.ColorIndex = -4142 'ActiveWorkbook.Sheets("xxx").Tab.ColorIndex = -4142 'add new group for color change Sheets("bluecard_homeplanaid").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowDeletingRows:=True, AllowFiltering:=True ActiveWorkbook.Save ActiveWorkbook.SaveAs Filename:= _ "H:\RBlakeman\RTA Desk\Reports\backups\bluecard_homeplanaid_master_b ackup.xls" _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Else Workbooks("bluecard_homeplanaid_Master").Activate ' remove color from all tabs Sheets(Array("bzv", "kpx", "uco", "hvu", "generic", "bnl", "eca", "fus", "och", "rkk", "hbg", "lmp", "nfh")).Select Sheets("generic").Activate ActiveWorkbook.Sheets("generic").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("nfh").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("bnl").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("hvu").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("uco").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("kpx").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("bzv").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("eca").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("fus").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("och").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("rkk").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("hbg").Tab.ColorIndex = -4142 ActiveWorkbook.Sheets("lmp").Tab.ColorIndex = -4142 'ActiveWorkbook.Sheets("xxx").Tab.ColorIndex = -4142 'add new group for color change Sheets("bluecard_homeplanaid").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowDeletingRows:=True, AllowFiltering:=True ActiveWorkbook.Save ActiveWorkbook.Close End If Else ' Auto Fit Columns Sheets("bluecard_homeplanaid").Select Columns("A:I").EntireColumn.AutoFit ' align left columns E and C Sheets("bluecard_homeplanaid").Select Range("E3").Select Range(Selection, Selection.End(xlDown)).Select With Selection |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
how to find the data after we delete | Excel Discussion (Misc queries) | |||
Delete if find a data format | Excel Programming | |||
How can I find and delete tabs and carriage returns ? | Excel Discussion (Misc queries) | |||
Find last row of data and delete empty rows | Excel Programming | |||
Find and Delete data in a column | Excel Programming |