Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
Hello all,
I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
see if this does what you want. Suggest that you make back-up of your data
before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
Hi John,
I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
It means it can't find a worksheet with that name - I copied the names from
your post - check the spellings & try again. -- jb "Peruanos72" wrote: Hi John, I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
The spelling was correct. my code copies my tabs to a new workbook so the
master file is not touched and my code runs in the new workbook from the master file. it appears your code doesn't work in the new book that's created but it does work if done in the master file. Is there a way to run your code in my new workbook? "john" wrote: It means it can't find a worksheet with that name - I copied the names from your post - check the spellings & try again. -- jb "Peruanos72" wrote: Hi John, I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
did not see that requirement in your original post.
Yes is the short answer but it would help if you post all the code you are using. I am about to leave office & out for evening will respond asap -- jb "Peruanos72" wrote: The spelling was correct. my code copies my tabs to a new workbook so the master file is not touched and my code runs in the new workbook from the master file. it appears your code doesn't work in the new book that's created but it does work if done in the master file. Is there a way to run your code in my new workbook? "john" wrote: It means it can't find a worksheet with that name - I copied the names from your post - check the spellings & try again. -- jb "Peruanos72" wrote: Hi John, I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
Here's my code. It's in two parts b/c it's lengthy. And thanks again for your
help. Sub update() ' ' update Macro ' Macro recorded 3/30/2009 by rblakeman ' ' 'Begin update Sheets(Array("bluecard_homeplanaid", "bzv", "kpx", "uco", "hvu", "generic", "bnl", "eca", "fus", "och", "rkk", "hbg", "lmp", "nfh")).Copy Sheets("bluecard_homeplanaid").Select ActiveSheet.Unprotect Range("L1").Clear ' BZV Range("A4").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A4").Select Sheets("bzv").Select 'Import Range("B2").Select Dim ans1 As Long ans1 = MsgBox("Import Data for ""BZV""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans1 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "BZV" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("kpx").Select Else ActiveSheet.Next.Select On Error Resume Next End If ' END BZV 'IMPORT KPX Range("B2").Select Dim ans2 As Long ans2 = MsgBox("Import Data for ""KPX""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans2 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "KPX" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("uco").Select Else ActiveSheet.Next.Select On Error Resume Next End If ' END KPX 'IMPORT UCO Range("B2").Select Dim ans3 As Long ans3 = MsgBox("Import Data for ""UCO""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans3 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "UCO" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("hvu").Select Else ActiveSheet.Next.Select On Error Resume Next End If 'END UCO 'IMPORT HVU Range("B2").Select Dim ans4 As Long ans4 = MsgBox("Import Data for ""HVU""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans4 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "HVU" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("generic").Select Else ActiveSheet.Next.Select On Error Resume Next End If 'END HVU 'IMPORT GENERIC Range("B2").Select Dim ans5 As Long ans5 = MsgBox("Import Data for ""Generic""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans5 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "GENERIC" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("bnl").Select Else ActiveSheet.Next.Select On Error Resume Next End If ' END GENERIC 'IMPORT BNL Range("B2").Select Dim ans6 As Long ans6 = MsgBox("Import Data for ""BNL""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans6 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "BNL" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("eca").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End BNL 'IMPORT ECA Range("B2").Select Dim ans7 As Long ans7 = MsgBox("Import Data for ""ECA""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE If ans7 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "ECA" ' ENTER NEW GROUP ACRONYM If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("fus").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End ECA 'IMPORT FUS Range("B2").Select Dim ans8 As Long ans8 = MsgBox("Import Data for ""FUS""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE If ans8 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "FUS" ' ENTER NEW GROUP ACRONYM If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("och").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End FUS 'Import OCH Range("B2").Select Dim ans9 As Long ans9 = MsgBox("Import Data for ""OCH""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE If ans9 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "OCH" ' ENTER NEW GROUP ACRONYM If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("rkk").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End OCH 'Import RKK Range("B2").Select Dim ans10 As Long ans10 = MsgBox("Import Data for ""RKK""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE If ans10 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "RKK" ' ENTER NEW GROUP ACRONYM If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("hbg").Select Else ActiveSheet.Next.Select On Error Resume Next End If ' End RKK 'IMPORT HBG Range("B2").Select Dim ans11 As Long ans11 = MsgBox("Import Data for ""HBG""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans11 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "HBG" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("LMP").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End HBG 'IMPORT LMP Range("B2").Select Dim ans12 As Long ' Change XXX to next number in sequence ans12 = MsgBox("Import Data for ""LMP""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE If ans12 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "LMP" ' ENTER NEW GROUP ACRONYM If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Sheets("NFH").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB Else ActiveSheet.Next.Select On Error Resume Next End If ' End LMP 'IMPORT NEW TAB ' Range("B2").Select ' Dim ansXXX As Long ' Change XXX to next number in sequence ' ansXXX = MsgBox("Import Data for ""XXX""?", vbYesNo + vbQuestion + vbDefaultButton2) ' ENER NEW GROUP ACRONYM ABOVE ' If ansXXX = vbYes Then ' Range("B2").Select ' Selection.QueryTable.Refresh BackgroundQuery:=False ' Range("A2").Select ' Range(Selection, Selection.End(xlDown)).ClearContents 'Update ' Range("A2").Select ' Range("A2") = "XXX" ' ENTER NEW GROUP ACRONYM ' If Range("B3") = "" Then ' do nothing ' Else ' LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row ' col = ActiveCell.Column ' FormulaRow = ActiveCell.Row ' Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown ' End If 'copy paste ' LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row ' Range("A2:G" & LastRow).Select ' Selection.Copy ' Sheets("bluecard_homeplanaid").Select ' With Columns(1) ' Set C = .Find(what:="", after:=Cells(3, 1)) ' C.Select ' End With ' ActiveSheet.Paste ' Sheets("XXX").Select ' IF A NEW TAB IS CREATED THEN CHANGE THE SHEET NAME TO RELFECT NEW TAB 'Else 'ActiveSheet.Next.Select 'On Error Resume Next 'End If ' End NEW TAB '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' 'NEW TAB ABOVE 'NEW TAB ABOVE 'NEW TAB ABOVE 'NEW TAB ABOVE 'NEW TAB ABOVE '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''' 'IMPORT NFH (FINAL IMPORT) Range("B2").Select Dim ans750 As Long ans750 = MsgBox("Import Data for ""NFH""?", vbYesNo + vbQuestion + vbDefaultButton2) If ans750 = vbYes Then Range("B2").Select Selection.QueryTable.Refresh BackgroundQuery:=False Range("A2").Select Range(Selection, Selection.End(xlDown)).ClearContents 'Update Range("A2").Select Range("A2") = "NFH" If Range("B3") = "" Then ' do nothing Else LastRow = ActiveCell.Offset(0, 3).End(xlDown).Row col = ActiveCell.Column FormulaRow = ActiveCell.Row Range(Cells(FormulaRow, col), Cells(LastRow, col)).FillDown End If 'copy paste LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Range("A2:G" & LastRow).Select Selection.Copy Sheets("bluecard_homeplanaid").Select With Columns(1) Set C = .Find(what:="", After:=Cells(3, 1)) C.Select End With ActiveSheet.Paste Else Sheets("bluecard_homeplanaid").Select On Error Resume Next End If ' END NFH ' ***** DO NOT PUT ANOTHER IMPORT HERE. IT MUST BE PLACED BEFORE NFH ****** "john" wrote: did not see that requirement in your original post. Yes is the short answer but it would help if you post all the code you are using. I am about to leave office & out for evening will respond asap -- jb "Peruanos72" wrote: The spelling was correct. my code copies my tabs to a new workbook so the master file is not touched and my code runs in the new workbook from the master file. it appears your code doesn't work in the new book that's created but it does work if done in the master file. Is there a way to run your code in my new workbook? "john" wrote: It means it can't find a worksheet with that name - I copied the names from your post - check the spellings & try again. -- jb "Peruanos72" wrote: Hi John, I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
' 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 .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom End With Range("C3").Select Range(Selection, Selection.End(xlDown)).Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom End With Range("A4").Select ' remove lines Range("A5").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select 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 Range("A4").Select 'remove id numbers with alpha characters. LastRow = Range("E" & Rows.Count).End(xlUp).Row For r = LastRow To 4 Step -1 If Not IsNumeric(Cells(r, "E")) Then Rows(r).Delete End If Next ' Unique Records only Range("A3").Select Range("A3:G3").Select Range(Selection, Selection.End(xlDown)).Select Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True Dim ans19 As Long ans19 = MsgBox("Is today Monday?", vbYesNo + vbQuestion + vbDefaultButton2, "Report Date Confirmation") If ans19 = 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 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowDeletingRows:=True, AllowFiltering:=True Dim ans_bu2 As Long ans_bu2 = MsgBox("Backup Bluecard Homeplanaid?", vbYesNoCancel + vbDefaultButton2, "Backup File?") If ans_bu2 = 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("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.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 End If End Sub "john" wrote: did not see that requirement in your original post. Yes is the short answer but it would help if you post all the code you are using. I am about to leave office & out for evening will respond asap -- jb "Peruanos72" wrote: The spelling was correct. my code copies my tabs to a new workbook so the master file is not touched and my code runs in the new workbook from the master file. it appears your code doesn't work in the new book that's created but it does work if done in the master file. Is there a way to run your code in my new workbook? "john" wrote: It means it can't find a worksheet with that name - I copied the names from your post - check the spellings & try again. -- jb "Peruanos72" wrote: Hi John, I'm getting a "Subscript out of range" error when the code hits Set ws1 = .Worksheets("untitled") i moved that worksheet so it's the first worksheet but the error still comes up. I only have the two worksheets in the workbook. Thoughts?? "john" wrote: see if this does what you want. Suggest that you make back-up of your data before testing. Sub DeleteData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim StartRow As Long Dim EndRow As Long Dim Lr As Long Dim FoundCell As Range Dim Search As String Dim icount As Long With ThisWorkbook Set ws1 = .Worksheets("untitled") Set ws2 = .Worksheets("bluecard_homeplanaid") End With 'assume you have a header in row 1 StartRow = 2 icount = 0 With ws1 EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row For Lr = StartRow To EndRow Search = .Cells(Lr, 2).Value If Search < "" Then Set FoundCell = ws2.Columns(2).Find(Search, _ After:=ws2.Cells(1, 2), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) If FoundCell Is Nothing = False Then FoundCell.EntireRow.Delete icount = icount + 1 End If End If Next End With msg = MsgBox(icount & " Records Deleted", vbInformation, "Delete Data") End Sub -- jb "Peruanos72" wrote: Hello all, I have a tab named "untitled" and a tab named "bluecard_homeplanaid". I have data in tab "untitled" column "B". They're numbers such as 200906180333. I need code to that takes the number in the first cell "B1" in tab "untitled" and searches column "B" in tab "bluecard_homeplanaid". If found, then that row in tab "bluecard_homeplanaid" would be deleted. This process repeats for all of the numbers in column "B" in tab "untitled. Note: The amount of data in column "B" , tab "untitled" changes daily. thanks in advance!!! |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
find/delete data on different tabs
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 .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom End With Range("C3").Select Range(Selection, Selection.End(xlDown)).Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom End With Range("A4").Select ' remove lines Range("A5").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select 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 Range("A4").Select 'remove id numbers with alpha characters. LastRow = Range("E" & Rows.Count).End(xlUp).Row For r = LastRow To 4 Step -1 If Not IsNumeric(Cells(r, "E")) Then Rows(r).Delete End If Next ' Unique Records only Range("A3").Select Range("A3:G3").Select Range(Selection, Selection.End(xlDown)).Select Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True Dim ans19 As Long ans19 = MsgBox("Is today Monday?", vbYesNo + vbQuestion + vbDefaultButton2, "Report Date Confirmation") If ans19 = 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
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 |