
Active Member
Dashboards

May 31, 2016

I need to a code that will delete the first 6 rows of a spreadsheet and find the row that has string "HOURS AND RATES" and delete that row and the next 15 row beneath it.

VIP

Trusted Members

June 25, 2016

Hi Curt
In which column is the string "HOURS AND RATES" located?
The below code assumes that it is in column A. Change if it is in another column
Sub DeleteRows()
Application.ScreenUpdating = False
Dim rw As Long
'Delete first 6 rows
ActiveSheet.Rows("1:6").Delete
'Find text and delete 16 rows
'Change the column if necessary
rw = Application.Match("HOURS AND RATES", Range("A:A"), 0)
ActiveSheet.Rows(rw & ":" & rw + 15).Delete
Application.ScreenUpdating = True
End Sub

VIP

Trusted Members

June 25, 2016


Active Member
Dashboards

May 31, 2016

It does help, but I a little confused. I have a routine that transforms files within a folder that a friend helped. I wanted to insert the above code to be ran at the same time. So, where would the provided code be inserted?
My Routine:
Option Explicit
Private Sub CommandButton1_Click()
Dim FileSystem As Object
Dim SourceFolder As String, ResultFolder As String
Dim Folder As Object
Dim File As Object
SourceFolder = Range("B1").Value
If Right(SourceFolder, 1) <> "\" Then SourceFolder = SourceFolder & "\"
ResultFolder = Range("B2").Value
If Right(ResultFolder, 1) <> "\" Then ResultFolder = ResultFolder & "\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set Folder = FileSystem.GetFolder(SourceFolder)
For Each File In Folder.Files
If File.Name Like "*.xlsx" Then
modify File.Path
File.Move ResultFolder
DoEvents
End If
Next File
End Sub
Sub modify(Fname As String)
Dim i As Long, srd As String
Dim M As Variant
Dim wb As Workbook
Dim q As Integer
M = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
Set wb = Workbooks.Open(Fname)
With wb.Worksheets(1)
.Cells.UnMerge
i = 1
Do
If .Cells(i, 1) = "SRD" Then
.Cells(i, 17) = "YEAR"
.Cells(i, 18) = "MONTH"
.Cells(i, 19) = "DATE"
.Cells(i, 20) = "BASE"
.Cells(i, 21) = "FLEET"
Exit Do
End If
i = i + 1
Loop
i = i + 1
Do While .Cells(i, 2) <> ""
srd = .Cells(i, 1)
.Cells(i, 17) = Left(.Cells(1, 8), 4)
.Cells(i, 18) = M(Int(Right(.Cells(1, 8), 2)) - 1)
.Cells(i, 19) = DateSerial(Left(.Cells(1, 8), 4), Right(.Cells(1, 8), 2), 1)
.Cells(i, 20) = .Cells(1, 2)
.Cells(i, 21) = .Cells(1, 4)
i = i + 1
Do While .Cells(i, 1) = "" And .Cells(i, 2) <> ""
.Cells(i, 1) = srd
.Cells(i, 17) = Left(.Cells(1, 8), 4)
.Cells(i, 18) = M(Int(Right(.Cells(1, 8), 2)) - 1)
.Cells(i, 19) = DateSerial(Left(.Cells(1, 8), 4), Right(.Cells(1, 8), 2), 1)
.Cells(i, 20) = .Cells(1, 2)
.Cells(i, 21) = .Cells(1, 4)
i = i + 1
Loop
Loop
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

VIP

Trusted Members

June 25, 2016

Hi Curt
Try this but I suggest you use sample files as your codes above saves and override your original files (very dangerous)
1) Add this to the top of your code in the MODIFY sub module with the rest of the DIM
Dim rw As Long
2) Adding this code after the two Loop,Loop above
Loop
Loop
.Rows("1:6").Delete
rw = Application.Match("HOURS AND RATES", .Range("A:A"), 0)
.Rows(rw & ":" & rw + 15).Delete
WARNING : The code have not been tested. Please test it on sample files.
Sunny

Answers Post
1 Guest(s)
