Dim vList, lArrCounter As Long
Dim rngFound As Range, rngToDelete As Range, sFirstAddress As String
Application.ScreenUpdating = False
vList = Array("ier No :", "REPTS", "------")
For lArrCounter = LBound(vList) To UBound(vList)
With Sheet1.UsedRange
Set rngFound = .Find( _
What:=vList(lArrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
sFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = sFirstAddress
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lArrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Dim iRow As Long
Dim r As Range
Set r = ActiveSheet.UsedRange
For iRow = r.Row + r.Rows.Count - 1 To r.Row Step -1
If WorksheetFunction.CountA(r.Rows(iRow)) = 0 Then r.Rows(iRow).EntireRow.Delete
Next iRow
It should delete the"------" lines out of the spreadsheet but isn't. I tried running just the array part of the code up to the relevant point, got the result and then used this to put the code in by itself and it seems to run fine (See result in ALCOHOL MASTER2) but when it is in the full code below the end result has the "------" still in the last column. I am sure I am missing something stupid but can't see it. Any help please would be appreciated..The proper full code is in ALCRUN2 and the text file needed is ALCOHOL MASTER.txt. Obviously you will need to change the path to run it.
' ALCOHOLPICK Macro
' Macro recorded 16/09/2010 by Paul555555
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
ChDir "C:\Documents and Settings\PaulB\Desktop"
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\PaulB\Desktop\ALCOHOL MASTER.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _
1), Array(5, 1), Array(13, 1), Array(19, 1), Array(43, 1), Array(49, 1), Array(53, 1), Array _
(59, 1), Array(66, 1), Array(72, 1), Array(78, 1), Array(92, 1), Array(100, 1), Array(105, 1 _
), Array(113, 1), Array(120, 1), Array(125, 1))
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Dim vList, lArrCounter As Long
Dim rngFound As Range, rngToDelete As Range, sFirstAddress As String
Application.ScreenUpdating = False
vList = Array("ier No :", "REPTS", "------")
For lArrCounter = LBound(vList) To UBound(vList)
With Sheet1.UsedRange
Set rngFound = .Find( _
What:=vList(lArrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
sFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = sFirstAddress
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lArrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Dim iRow As Long
Dim r As Range
Set r = ActiveSheet.UsedRange
For iRow = r.Row + r.Rows.Count - 1 To r.Row Step -1
If WorksheetFunction.CountA(r.Rows(iRow)) = 0 Then r.Rows(iRow).EntireRow.Delete
Next iRow
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(MOD(ROW(),1)=1, """", R[-1]C[-15])"
Range("R2").Select
Selection.Copy
Range("R2:R500").Select
ActiveSheet.Paste
Columns("R:R").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("1:20").Select
Range("A20").Activate
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Columns.AutoFit
Selection.Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:=Range("Q2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="Trans"
Rows("93:388").Select
Range("C93").Activate
Selection.Delete Shift:=xlUp
Columns("K:L").Select
Selection.EntireColumn.Hidden = True
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = ""
Cells.Select
Selection.AutoFilter
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="Trans"
.PrintTitleRows = ""
.PrintTitleColumns = ""
Range("A1").Select
ActiveCell.FormulaR1C1 = "Supp"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Bin"
Range("C1").Select
ActiveCell.FormulaR1C1 = "SngC"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Product"
Range("E1").Select
ActiveCell.FormulaR1C1 = ""
Range("G1").Select
ActiveCell.FormulaR1C1 = "Ord"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Bal"
Range("J1").Select
ActiveCell.FormulaR1C1 = ""
Range("M1").Select
ActiveCell.FormulaR1C1 = "Conv"
Range("N1").Select
ActiveCell.FormulaR1C1 = "+/-"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Act"
Range("P1").Select
ActiveCell.FormulaR1C1 = "+/-"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "CBin"
Range("R1").Select
ActiveCell.FormulaR1C1 = "C.Code"
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
End With
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks