Delete rows/collums containing certain values with a Macro
I removed the spaces at the beginning with
'remove space at beginning of line
Do While StrComp(Left(CellData, 1), " ") = 0
CellData = Mid(CellData, 2)
Loop
Removed this line from here and move below
Cells(RowCount, 1) = CellData
Now add this code
'remove space at end of line
Do While StrComp(Right(CellData, 1), " ") = 0
CellData = Left(CellData, Len(CellData) - 1)
Loop
Cells(RowCount, 1) = CellData
"Joel" wrote:
I don't know hwatt changes your made, but I added a small routine at the end
of the code (see below). don't kow if you wanted the row with Total to havve
formula. if not make this changes: from LastRow to: LastRow - 1
Set TotalRange = Range(Cells(2, 3), Cells(LastRow - 1, 3))
For Each cell In TotalRange
RowString = Mid(Str(cell.Row), 2)
MyFormula = "=D" & RowString & "+" & "E" & RowString
cell.Formula = MyFormula
Next cell
Sub Macro1()
Range("A4") = Range("C1")
Rows("4:4").Font.Bold = True
Selection.Font.Bold = True
Rows("1:3").Delete shift:=xlUp
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
RowCount = 2
For LoopCount = 2 To LastRow
MyCell = Cells(RowCount, 1)
If InStr(MyCell, "London") 0 Then
Cells(RowCount, 1).EntireRow.Delete shift:=xlUp
Else
'remove items in parenthesis
CellData = ""
Found = False
For j = 1 To Len(MyCell)
If (Found = False) Then
If StrComp(Mid(MyCell, j, 1), "(") = 0 Then
Found = True
Else
CellData = CellData + Mid(MyCell, j, 1)
End If
Else
If StrComp(Mid(MyCell, j, 1), ")") = 0 Then
Found = False
End If
End If
Next j
'remove space at beginning of line
Do While StrComp(Left(CellData, 1), " ") = 0
CellData = Mid(CellData, 2)
Loop
Cells(RowCount, 1) = CellData
RowCount = RowCount + 1
End If
Next LoopCount
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set FindRange = Range(Cells(1, 1), Cells(LastRow, 1))
Set c = FindRange.Find("Total", LookIn:=xlValues)
LastColumn = Cells(c.Row, Columns.Count).End(xlToLeft).Column
Set TotalRange = Range(Cells(c.Row, 4), Cells(c.Row, LastColumn))
For Each cell In TotalRange
ColumnString = Mid(Str(cell.Column), 2)
RowString = Mid(Str(cell.Row - 1), 2)
MyFormula = "=SUM(R2" & "C" & ColumnString & ":"
MyFormula = MyFormula & "R" & RowString & "C" & ColumnString & ")"
cell.FormulaR1C1 = MyFormula
Next cell
ColumnCount = 4
For LoopCount = 4 To LastColumn
If Cells(c.Row, ColumnCount).Value = 0 Then
Cells(c.Row, ColumnCount).EntireColumn.Delete shift:=xlLeft
Else
ColumnCount = ColumnCount + 1
End If
Next LoopCount
Set TotalRange = Range(Cells(2, 3), Cells(LastRow, 3))
For Each cell In TotalRange
RowString = Mid(Str(cell.Row), 2)
MyFormula = "=D" & RowString & "+" & "E" & RowString
cell.Formula = MyFormula
Next cell
End Sub
"Hendrik" wrote:
Thanks Joel! It works perfectly now.
If you're up for it. There's another thing. I've modified the macro to add
new collumns before and after collum A (with the employee names).
In this new collumn C, I want the macro to enter a formula in C2, for
example "=D2+E2". and I want the macro to drag the formula down so every row
has the formula (the 3th row will have "=D3+E3" etc..).
The problem I can't figure out is, how to drag the formula down so each
employee/row has the formula. Keeping in mind that there might be a different
amount of rows each time.
Also, in the Total row, in collum C has to be a SUM of the above.
|