Help with macro please

B

Beekman

Board Regular
Joined
Nov 7, 2008
Messages
64
I have sheets named Monday thru to Friday
In Col A from A10 Have a list of numbers.(4 digits)
Some numbers end with a M,U,W,T,F

Want to delete rows with any numbers ending with U,W,T,F In Monday,

M,W,T,F in Tuesday, M,U,T,F in Wednesday, M,U,W,F in Thursday,

M,U,W,T in Friday and move rest of rows up

Is there a macro I can use for all days at once or would it be better a seperate one for each day?

Thanks, in advance, Ben
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
How's the exact representation of numbers?
Ex.
1234M or
1234 M or
1234_M
Can you be specific?
 
Upvote 0
It's jsut as easy to write a macro to do both

Code: 
Option Compare Text
Sub del()
    Dim r(4) As Variant
    Application.ScreenUpdating = False
    r(0) = Array("Monday", "UWTF")
    r(1) = Array("Tuesday", "MWTF")
    r(2) = Array("Wednesday", "MUTF")
    r(3) = Array("Thursday", "MUWF")
    r(4) = Array("Friday", "MUWT")
    For i = 0 To 4
        With Sheets(r(i)(0))
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            c = r(i)(1)
            For j = lr To 10 Step -1
                If InStr(c, Right(.Cells(j, "A").Value, 1)) > 0 Then
                    Rows(j).Delete xlUp
                End If
            Next j
        End With
    Next i
End Sub
 
Upvote 0
Thanks, Weaver, Seems to work But have to run maro for each day. is it possible torun macro for all days at once?

Also if I run macro on say Monday more than once it deletes more rows. Ones with no letters. Evertime you run it more lines get deleted.

Numbers in cell is 4 didgets and letter eg, 4100,4125W

Thanks, again
 
Upvote 0
I have written so I will post it.

The RemoveRows procedure determines which parameters to send to the ProcessDay procedure using a Select Case statement.


Code: 
[COLOR=darkblue]Sub[/COLOR] RemoveRows()
   [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Worksheets
      [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] ws.Name
         [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Is[/COLOR] = "Monday"
            ProcessDay ws, "U", "W", "T", "F"
         [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Is[/COLOR] = "Tuesday"
            ProcessDay ws, "M", "W", "T", "F"
         [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Is[/COLOR] = "Wednesday"
            ProcessDay ws, "M", "U", "T", "F"
         [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Is[/COLOR] = "Thursday"
            ProcessDay ws, "M", "U", "W", "F"
         [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]
            ProcessDay ws, "M", "U", "W", "T"
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
   [COLOR=darkblue]Next[/COLOR] ws
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=#00008b][/COLOR] 
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] ProcessDay([COLOR=darkblue]ByVal[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet, _
                        [COLOR=darkblue]ByVal[/COLOR] txt1 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                        [COLOR=darkblue]ByVal[/COLOR] txt2 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                        [COLOR=darkblue]ByVal[/COLOR] txt3 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                        [COLOR=darkblue]ByVal[/COLOR] txt4 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR])
   [COLOR=darkblue]Dim[/COLOR] lr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] strTemp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
   lr = ws.Range("A" & Rows.Count).End(xlUp).Row
 
   [COLOR=darkblue]For[/COLOR] i = lr [COLOR=darkblue]To[/COLOR] 2 [COLOR=darkblue]Step[/COLOR] -1
      strTemp = ws.Range("A" & i).Value
      [COLOR=darkblue]If[/COLOR] UCase(Right(strTemp, 1)) = txt1 Or _
         UCase(Right(strTemp, 1)) = txt2 Or _
         UCase(Right(strTemp, 1)) = txt3 Or _
         UCase(Right(strTemp, 1)) = txt4 [COLOR=darkblue]Then[/COLOR]
 
         ws.Rows(i).EntireRow.Delete Shift:=xlUp
       [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]Next[/COLOR] i
 
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
ps An even simpler way to do this would be to test if the value in column A in each worksheet was numeric.

Code: 
[COLOR=darkblue]Sub[/COLOR] test2()
   [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] lr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
 
   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Worksheets
      lr = ws.Range("A" & Rows.Count).End(xlUp).Row
 
      [COLOR=darkblue]For[/COLOR] i = lr [COLOR=darkblue]To[/COLOR] 2 [COLOR=darkblue]Step[/COLOR] -1
         [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] IsNumeric(ws.Range("A" & i).Value) [COLOR=darkblue]Then[/COLOR]
            ws.Rows(i).EntireRow.Delete Shift:=xlUp
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i
   Next ws
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
Tried yours Bertie but yours removed all above rows with letters on each day including the one meant to keep eg

M on Monday

U on Tuesday

W on Wdenesday

T on Thursday

F on Friday
 
Upvote 0
Beekman said:
Tried yours Bertie but yours removed all above rows with letters on each day including the one meant to keep eg

M on Monday

U on Tuesday

W on Wdenesday

T on Thursday

F on Friday
Click to expand...

As a small adjustment to Bertie's code:
Code: 
Sub RemoveRows()
   Dim ws As Worksheet
   For Each ws In Worksheets
      Select Case ws.Name
         Case Is = "Monday"
            ProcessDay ws, "U", "W", "T", "F"
         Case Is = "Tuesday"
            ProcessDay ws, "M", "W", "T", "F"
         Case Is = "Wednesday"
            ProcessDay ws, "M", "U", "T", "F"
         Case Is = "Thursday"
            ProcessDay ws, "M", "U", "W", "F"
         Case Is = "Friday"
            ProcessDay ws, "M", "U", "W", "T"
      End Select
   Next ws
End Sub
 
 
Private Sub ProcessDay(ByVal ws As Worksheet, _
                        ByVal txt1 As String, _
                        ByVal txt2 As String, _
                        ByVal txt3 As String, _
                        ByVal txt4 As String)
   Dim lr As Long
   Dim i As Long
   Dim strTemp As String
 
   lr = ws.Range("A" & Rows.Count).End(xlUp).Row
 
   For i = lr To 2 Step -1
      strTemp = ws.Range("A" & i).Value
strTemp = UCase(Right(strTemp, 1))
      If strTemp = txt1 Or _
         strTemp = txt2 Or _
         strTemp = txt3 Or _
         strTemp = txt4 Then
 
         ws.Rows(i).EntireRow.Delete
       End If
   Next i
 
End Sub

Should work?
 
Last edited:
Upvote 0
Beekman said:
Thanks, Weaver, Seems to work But have to run maro for each day. is it possible torun macro for all days at once?

Also if I run macro on say Monday more than once it deletes more rows. Ones with no letters. Evertime you run it more lines get deleted.

Numbers in cell is 4 didgets and letter eg, 4100,4125W

Thanks, again
Click to expand...
The way the code was supposed to work was to test the last character of anything in column A against the pattern.

So for the Monday sheet the pattern is "UWTF" so if the last character doesn't appear in the string (not case sensitive) then it shouldn't delete it. I tested it on a very sparse and ad hoc dataset to be fair, but I can't see why it would delete more rows than necessary, (i.e if it deleted all the right items the first time, subsequent runs would delete nothing as there should be nothing left to fulfill the conditions, unless I've not understood your problem correctly.

If the other solutions aren't working out, can you post a bit of test data from each sheet so I can have another look at it?

PS this should process all 5 sheets - what's the procedure for updating these sheets? I'm not really sure I understand your comment
is it possible torun macro for all days at once?
Click to expand...
 
Upvote 0
Weaver said:
The way the code was supposed to work was to test the last character of anything in column A against the pattern.

So for the Monday sheet the pattern is "UWTF" so if the last character doesn't appear in the string (not case sensitive) then it shouldn't delete it. I tested it on a very sparse and ad hoc dataset to be fair, but I can't see why it would delete more rows than necessary, (i.e if it deleted all the right items the first time, subsequent runs would delete nothing as there should be nothing left to fulfill the conditions, unless I've not understood your problem correctly.

If the other solutions aren't working out, can you post a bit of test data from each sheet so I can have another look at it?

PS this should process all 5 sheets - what's the procedure for updating these sheets? I'm not really sure I understand your comment
Click to expand...

I like fixing errors so I tested your code against a random set of data I created quickly. Have a look at the below:

Code: 
Option Compare Text
Sub del()
    Dim r(4) As Variant
    Application.ScreenUpdating = False
    r(0) = Array("Monday", "UWTF")
    r(1) = Array("Tuesday", "MWTF")
    r(2) = Array("Wednesday", "MUTF")
    r(3) = Array("Thursday", "MUWF")
    r(4) = Array("Friday", "MUWT")
    For i = 0 To 4
        With Sheets(r(i)(0))
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            c = r(i)(1)
            For j = lr To 10 Step -1
                If InStr(c, Right(.Cells(j, "A").Value, 1)) > 0 Then
                    [B].Rows(j).Delete[/B]
                End If
            Next j
        End With
    Next i
End Sub

The only bit I changed is bolded - mainly from 'Rows' to '.Rows'. I also took out xlUp as I really didn't see any need for it. Thought it would probably make it delete more rows than necessary.
Then it works like a dream!!
Great use of a 2-dimensional array though :) (I think... I've never seen or used one before!)

Hope this helps!
Adam

PS - If you're interested I used this formula to get a test set of data very quickly:
Code: 
=RANDBETWEEN(1000, 9999) & VLOOKUP( RANDBETWEEN(1, 5), LookupData!$A$1:$B$5, 2, FALSE)
With the VLOOKUP finding the corresponding days letter. Used this to get a Mon - Fri sample ranging from Row 10 all the way to Row 1000. Just for good measure I added the current row number in Col B (=ROW) and then pasted the values over and let it run.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
Formula Error: Error applying formula with VBA even though it works manually
Replies
3
Views
119
6StringJazzer
6StringJazzer
H
  • Solved
Color 3 cells.
Replies
4
Views
111
harzer
H
H
  • Solved
Retrieve the intersection of multiple cells with respect to columns and rows
2
Replies
10
Views
154
mumps
mumps
willow1985
  • Solved
Call a macro based on text in column C (same row that is active).
Replies
8
Views
130
6StringJazzer
6StringJazzer
M
  • Solved
Simple stock control
Replies
7
Views
342
mumps
mumps

Forum statistics

Threads
1,224,599
Messages
6,179,828
Members
452,946
Latest member
JoseDavid

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top