G
Guest
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.
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.