Log In
Register
Home
Active Member
Dashboards
May 31, 2016
Offline
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.
See Answer
VIP
Trusted Members
June 25, 2016
Offline
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
Active Member
Dashboards
May 31, 2016
Offline
Column is correct. Do I need to specify a specific sheet name because it will be applied to multiple files in a folder?
VIP
Trusted Members
June 25, 2016
Offline
The macro works on the active sheet.
Lets say the macro is saved in Workbook A.
You open Workbook A then open Workbook B.
Select the sheet to delete the rows in Workbook B and then run the macro from the Developer tab.
Hope this helps.
Active Member
Dashboards
May 31, 2016
Offline
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
Offline
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)
