View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default 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.