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, 2), 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 = 2
For LoopCount = 2 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
End Sub
"Hendrik" wrote:
Great Joel! just one thing;
- I want the contents of C1 to be copied to A4. I see this in the Macro as
well. But it always gives "TRUE" in cell A4 instead of the contents of cell
C1.
Also, i forgot to mention this in my original post. When all the employees
from other sites are removed and I'm left with this employee
"(Amsterdam) employee, one (manager one)"
I'd like to remove "(Amsterdam)" and "(manager one)" and the space before
and after the employee name. I'll only have 1 site to remove (amsterdam) but
I could have 3 or 4 different manager names. The site and manager names are
always between brackets ( ). I'm not sure how to do this. Let me know if you
need more info.
Thank you Very much for your help so far.
"Joel" wrote:
Is this what you want
Sub Macro1()
Range("A4") = Range("C1").Copy
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
If InStr(Cells(RowCount, 1), "London") 0 Then
Cells(RowCount, 1).EntireRow.Delete shift:=xlUp
Else
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, 2), 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 = 2
For LoopCount = 2 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
End Sub
"Hendrik" wrote:
I have a big excel file with in column A the names of all employees. A name
is displayed in the following format:
(location) Employee name (Manager name)
I've uploaded a version with only two employees as an example. You can
download it he
http://www.box.net/shared/p9uzf22tha
When you open this file, I want to perform the following actions with a
single macro, if possible:
1- Copy contents cell C1 to A4
2- Select row 4 and set the format to bold
3- Delete rows 1+2+3
4- Delete all rows containing the word "London"
5- The total row currently only shows the values (import from another
program). I want it to display the SUM of the above cells.
6- Now I want all columns which have a total SUM of 0.00 to be deleted
The result should look like this:
http://www.box.net/shared/ybh0hkrejn
Any help on this is greatly appreciated!