Macro assistance please - again!
 

Hi all and thanks for reading this.
I'm very green when it comes to macros but I've patched together various
bits from various places and come up with this:

Sub Tillfilepart2()
'
' Tillfilepart2 Macro
' Macro recorded 20/02/2006 by Andy
'

'
'Delete rows with VOID in column K
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rcell As Range
Dim delRng As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = "VOID"
Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
LRow = Cells(Rows.Count, "K").End(xlUp).Row

Set rng = SH.Range("K1").Resize(LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rcell In rng.Cells
If LCase(rcell.Value) = LCase(sStr) Then
If delRng Is Nothing Then
Set delRng = rcell
Else
Set delRng = Union(rcell, delRng)
End If
End If
Next rcell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If


Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("H3").Select
Selection.Sort Key1:=Range("I3"), Order1:=xlAscending, HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("J1").Formula = "TA"
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
Range("N1").Formula = "GP"

Dim r As Long
r = Cells(Rows.Count, "A").End(xlUp).Row
Range("J2").Formula = "=--NOT(H2=H1)"
Range("J2").AutoFill Destination:=Range("J2:J" & r)
Range("N2").Formula = _
"=IF(A2=125,(G2/100)*(M2<0)*(M2+0.5),((G2/1.175)/100)*(M2<0)*(M2+0.5))"
Range("N2").AutoFill Destination:=Range("N2:N" & r)

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Range("A2").Select

End Sub

I'm sure there are plenty of shortcuts that I've missed and duplicated bits
but the problem at the moment is that as well as deleting rows with VOID in
column K (near the top of the macro) I also want to delete rows containing
! in column B. I've tried to use code that's already there - but whichever
way I try I am getting errors. I've tried using a tStr string (as well as
the existing sStr) and other vain attempts and I can't do it!!
Please help.
Thanks.
Andy.

Macro assistance please - again!
 

Hi Andy,

Revising the original deletion code to include the condition that column B
include an exclamation mark, try:

'=============
Public Sub Tester001()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rcell As Range
Dim delRng As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = "VOID"
Const sStr2 As String = "!"

Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
LRow = Cells(Rows.Count, "K").End(xlUp).Row

Set rng = SH.Range("K1").Resize(LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rcell In rng.Cells
If LCase(rcell.Value) = LCase(sStr) _
Or InStr(1, rcell.Offset(0, -9).Value, sStr2, 0) Then
If delRng Is Nothing Then
Set delRng = rcell
Else
Set delRng = Union(rcell, delRng)
End If
End If
Next rcell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If
End Sub
'<<=============

I have not looked at (or included) your subsequent sort code.


---
Regards,
Norman



<Andy wrote in message ...
Hi all and thanks for reading this.
I'm very green when it comes to macros but I've patched together various
bits from various places and come up with this:

Sub Tillfilepart2()
'
' Tillfilepart2 Macro
' Macro recorded 20/02/2006 by Andy
'

'
'Delete rows with VOID in column K
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rcell As Range
Dim delRng As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = "VOID"
Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
LRow = Cells(Rows.Count, "K").End(xlUp).Row

Set rng = SH.Range("K1").Resize(LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rcell In rng.Cells
If LCase(rcell.Value) = LCase(sStr) Then
If delRng Is Nothing Then
Set delRng = rcell
Else
Set delRng = Union(rcell, delRng)
End If
End If
Next rcell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If


Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("H3").Select
Selection.Sort Key1:=Range("I3"), Order1:=xlAscending, HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("J1").Formula = "TA"
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
Range("N1").Formula = "GP"

Dim r As Long
r = Cells(Rows.Count, "A").End(xlUp).Row
Range("J2").Formula = "=--NOT(H2=H1)"
Range("J2").AutoFill Destination:=Range("J2:J" & r)
Range("N2").Formula = _

"=IF(A2=125,(G2/100)*(M2<0)*(M2+0.5),((G2/1.175)/100)*(M2<0)*(M2+0.5))"
Range("N2").AutoFill Destination:=Range("N2:N" & r)

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Range("A2").Select

End Sub

I'm sure there are plenty of shortcuts that I've missed and duplicated
bits but the problem at the moment is that as well as deleting rows with
VOID in column K (near the top of the macro) I also want to delete rows
containing ! in column B. I've tried to use code that's already there -
but whichever way I try I am getting errors. I've tried using a tStr
string (as well as the existing sStr) and other vain attempts and I can't
do it!!
Please help.
Thanks.
Andy.

Macro assistance please - again!
 

Brilliant!! Thanks very much. I'll just have to spend the next 2 hours
dissecting your code to work out how it does it!!!
Cheers. Much appreciated.
Andy.
"Norman Jones" wrote in message
...
Hi Andy,

Revising the original deletion code to include the condition that column B
include an exclamation mark, try:

'=============
Public Sub Tester001()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rcell As Range
Dim delRng As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = "VOID"
Const sStr2 As String = "!"

Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
LRow = Cells(Rows.Count, "K").End(xlUp).Row

Set rng = SH.Range("K1").Resize(LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rcell In rng.Cells
If LCase(rcell.Value) = LCase(sStr) _
Or InStr(1, rcell.Offset(0, -9).Value, sStr2, 0) Then
If delRng Is Nothing Then
Set delRng = rcell
Else
Set delRng = Union(rcell, delRng)
End If
End If
Next rcell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If
End Sub
'<<=============

I have not looked at (or included) your subsequent sort code.


---
Regards,
Norman



<Andy wrote in message ...
Hi all and thanks for reading this.
I'm very green when it comes to macros but I've patched together various
bits from various places and come up with this:

Sub Tillfilepart2()
'
' Tillfilepart2 Macro
' Macro recorded 20/02/2006 by Andy
'

'
'Delete rows with VOID in column K
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rcell As Range
Dim delRng As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = "VOID"
Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
LRow = Cells(Rows.Count, "K").End(xlUp).Row

Set rng = SH.Range("K1").Resize(LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rcell In rng.Cells
If LCase(rcell.Value) = LCase(sStr) Then
If delRng Is Nothing Then
Set delRng = rcell
Else
Set delRng = Union(rcell, delRng)
End If
End If
Next rcell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If


Selection.Sort Key1:=Range("H3"), Order1:=xlAscending,
HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("H3").Select
Selection.Sort Key1:=Range("I3"), Order1:=xlAscending,
HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("J1").Formula = "TA"
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
Range("N1").Formula = "GP"

Dim r As Long
r = Cells(Rows.Count, "A").End(xlUp).Row
Range("J2").Formula = "=--NOT(H2=H1)"
Range("J2").AutoFill Destination:=Range("J2:J" & r)
Range("N2").Formula = _

"=IF(A2=125,(G2/100)*(M2<0)*(M2+0.5),((G2/1.175)/100)*(M2<0)*(M2+0.5))"
Range("N2").AutoFill Destination:=Range("N2:N" & r)

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

Range("A2").Select

End Sub

I'm sure there are plenty of shortcuts that I've missed and duplicated
bits but the problem at the moment is that as well as deleting rows with
VOID in column K (near the top of the macro) I also want to delete rows
containing ! in column B. I've tried to use code that's already there -
but whichever way I try I am getting errors. I've tried using a tStr
string (as well as the existing sStr) and other vain attempts and I can't
do it!!
Please help.
Thanks.
Andy.