apply this VBA code to work in two worksheets in one workbook

[keilah]

Hi the good people.

Need urgent help in modifying this code. "so that what ever i delete from worksheet one, is also deleted from worksheet two"...base on the deletion criteria/string.....ie. if i delete barclay1 from worksheet 1, then also delete barclays 1 from worksheet 2, it dose not matter which row it is in as long as i specify the two col's.....i hope i have explained this properly.......

thanks

Sub DeleteRows()

Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC

'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)

SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

On Error Resume Next
Set MyRange = Columns(SearchColumn)
On Error GoTo 0

'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub

MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, else code will exit", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False

'to match the WHOLE text string
Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'to match a PARTIAL text string use this line
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
'to match the case and of a WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

If Not C Is Nothing Then
Set DelRange = C
FirstAddress = C.Address
Do
Set C = MyRange.FindNext(C)
Set DelRange = Union(DelRange, C)
Loop While FirstAddress <> C.Address
End If

'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

[rory]

Try this - change the array to match the sheet names you want:
Sub DeleteRows()
Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC
Dim varSheets, varItem
varSheets = Array("Sheet1", "Sheet2")
'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)
SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)
For Each varItem In varSheets
On Error Resume Next
Set MyRange = Worksheets(varItem).Columns(SearchColumn)
On Error GoTo 0

'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub
If MatchString = "" Then MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, else code will exit", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False

'to match the WHOLE text string
Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'to match a PARTIAL text string use this line
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
'to match the case and of a WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

If Not C Is Nothing Then
Set DelRange = C
FirstAddress = C.Address
Do
Set C = MyRange.FindNext(C)
Set DelRange = Union(DelRange, C)
Loop While FirstAddress <> C.Address
End If

'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
Next varItem
Application.ScreenUpdating = True
End Sub


HTH
Rory

[keilah]

thanks a lot....
i give it a quick test run......and email you back....

cheers

[keilah]

just a quick question......have you changed the vba code...so i have to insert the col's in the two diff sheets???????//

regards

[keilah]

no luck not working mate

[rory]

The code uses the same column and the same search string for both sheets - was that what you wanted?

[keilah]

No sorry diff col's.....need to state the two col's in the forumla....

just a quick fix.....is showing a error....

on this line If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

[rory]

What is the error? (I didn't change that line!)
How do you want to specify which column goes with which sheet? Is it always the same two sheets?
Regards,
Rory

[keilah]

You can tell i am new......

Yes always the same two sheet.......and i fix the sheets so the two columns are b for sheet one and col c for the second sheet.

the error was a run time.......

thnaks again for you knowledge......

[keilah]

Hi mate

any luck....i am having no luck on my end....just keeping you updated.....

thanks

[Bob Phillips]

Why don't you post your workbook and describe what you want to happen with specific examples.

[keilah]

Sorry cannot post the work book at work....i hope you understand....

the example is......

I have data in col B (sheet 1), and data in col c (sheet2)...and i want to delete a value from col b sheet1 and the same value to be deleted from col c (sheet2)...and so on......

at the moment the original vba is just deleting any row i say from col b in (sheet1)....

just that....

thanks for your help.......

[Bob Phillips]

What will trigger the delete?

And what determines which column(s) to work on?

[I hope you don't work for Barclays!]

[keilah]

no i do not work for barclays.....good to ask

which col's to work on - the data. only col b sheet 1 and col c sheet 2 (fixed)

a window open in which you enter the delete parameter.........

[Bob Phillips]

You might want to add some extra checks, but in essence




Public Sub Test()
Dim mpCriteria

mpCriteria = InputBox("provide selection criteria")

If mpCriteria <> False Then

Call DeleteData(Worksheets("Sheet1").Columns("B:B"), mpCriteria)
Call DeleteData(Worksheets("Sheet2").Columns("C:C"), mpCriteria)
End If

End Sub

Private Sub DeleteData(pzData As Range, pzCriteria)

pzData.Parent.Rows(1).Insert
pzData.Cells(1, 1).Value = "Temp"
pzData.AutoFilter field:=1, Criteria1:=pzCriteria
pzData.SpecialCells(xlCellTypeVisible).EntireRow.Delete

End Sub

[keilah]

Hi Mate

thamks for the extra code.....just a silly question...

is this extra code to add to the end of the code i have provided or well the vba macro work fine with the code you have provided.....please advise......new to all this

I also have one last problem which you might be abe to help me with.....if you are interested?

i look forward to your reply...

thanks

[keilah]

Hi mate XDL

i am going to attache the spreadsheet.....trying using my code and delete the same data from sheet 1 (abbey001) so that is also deleted from sheet at the same time.....


thanks.....again

[keilah]

sorry ight to add....the same time from sheet to also......