LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 58
Default find/delete data on different tabs

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how to find the data after we delete bayu Excel Discussion (Misc queries) 1 October 11th 08 05:54 PM
Delete if find a data format Junior728 Excel Programming 2 May 11th 07 09:50 AM
How can I find and delete tabs and carriage returns ? JeffEE Excel Discussion (Misc queries) 1 November 11th 05 02:47 PM
Find last row of data and delete empty rows Pat Excel Programming 3 February 17th 05 12:34 AM
Find and Delete data in a column rahul_chatterjee[_2_] Excel Programming 4 October 25th 04 11:08 PM


All times are GMT +1. The time now is 03:41 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"