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!

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!

Change the 1st statement (eliminate .copy)
from: Range("A4") = Range("C1").Copy
to: Range("A4") = Range("C1")


"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!

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!

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.

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.

Perfect, again.

As an example I gave you the formula "=D2+E2". I thought that I could
easily modify the formula in VBA, but I guess I'm not that advanced yet.

This is the actual formula that I want to use:

=IF(SUMPRODUCT(ISNUMBER(SEARCH("break",$E$1:$EE$1) )*(E2:EE2=0.25)),IF(SUMPRODUCT(ISERR(SEARCH("evt", $E$1:$EE$1))*(ISERR(SEARCH("ABS",$E$1:$EE$1)))*(IS ERR(SEARCH("Total",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ ",$E$1:$EE$1)))*(ISERR(SEARCH("lunch",$E$1:$EE$1)) )*E2:EE2)<=0.5,0,SUMPRODUCT(ISERR(SEARCH("evt",$E$ 1:$EE$1))*(ISERR(SEARCH("Total",$E$1:$EE$1)))*(ISE RR(SEARCH("ABS",$E$1:$EE$1)))*(ISERR(SEARCH("lunch ",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ",$E$1:$EE$1)))*E 2:EE2)),0)

What do I need to do to get this working? I've tried replacing the formula
after "MyFormula", but it doesn't work.

"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.

Anything this complicated should be writen as a cutom function and not as an
excel formula. it is eqasier to debug in VBA. You are pasing a range of
cells and looking for a true False response. the function would look like
this

Function MyFunction (MyRange as range)

For each cell in Myrange

Select Case Cell.value

case "Total"

case "Lunch"

case "evt"

case "Abs"

Case "break"



end select

Next cell

MyFunction = (true or false)

end Function


"Hendrik" wrote:

Perfect, again.

As an example I gave you the formula "=D2+E2". I thought that I could
easily modify the formula in VBA, but I guess I'm not that advanced yet.

This is the actual formula that I want to use:

=IF(SUMPRODUCT(ISNUMBER(SEARCH("break",$E$1:$EE$1) )*(E2:EE2=0.25)),IF(SUMPRODUCT(ISERR(SEARCH("evt", $E$1:$EE$1))*(ISERR(SEARCH("ABS",$E$1:$EE$1)))*(IS ERR(SEARCH("Total",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ ",$E$1:$EE$1)))*(ISERR(SEARCH("lunch",$E$1:$EE$1)) )*E2:EE2)<=0.5,0,SUMPRODUCT(ISERR(SEARCH("evt",$E$ 1:$EE$1))*(ISERR(SEARCH("Total",$E$1:$EE$1)))*(ISE RR(SEARCH("ABS",$E$1:$EE$1)))*(ISERR(SEARCH("lunch ",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ",$E$1:$EE$1)))*E 2:EE2)),0)

What do I need to do to get this working? I've tried replacing the formula
after "MyFormula", but it doesn't work.

"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.

I guess that was indeed a bit too far. But I'm satisfied the way it is now.
It's going to safe me a lot of hassle in the future.

There is just one issue I just noticed. Remember the employee names having
the format:

"(location) firstname, lastname (manager name)"

The 1 space after lastname stays intact, which makes it very difficult for
me to use them further in VLOOKUPs for example.

Any suggestions on how to correct this?


"Joel" wrote:

Anything this complicated should be writen as a cutom function and not as an
excel formula. it is eqasier to debug in VBA. You are pasing a range of
cells and looking for a true False response. the function would look like
this

Function MyFunction (MyRange as range)

For each cell in Myrange

Select Case Cell.value

case "Total"

case "Lunch"

case "evt"

case "Abs"

Case "break"



end select

Next cell

MyFunction = (true or false)

end Function


"Hendrik" wrote:

Perfect, again.

As an example I gave you the formula "=D2+E2". I thought that I could
easily modify the formula in VBA, but I guess I'm not that advanced yet.

This is the actual formula that I want to use:

=IF(SUMPRODUCT(ISNUMBER(SEARCH("break",$E$1:$EE$1) )*(E2:EE2=0.25)),IF(SUMPRODUCT(ISERR(SEARCH("evt", $E$1:$EE$1))*(ISERR(SEARCH("ABS",$E$1:$EE$1)))*(IS ERR(SEARCH("Total",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ ",$E$1:$EE$1)))*(ISERR(SEARCH("lunch",$E$1:$EE$1)) )*E2:EE2)<=0.5,0,SUMPRODUCT(ISERR(SEARCH("evt",$E$ 1:$EE$1))*(ISERR(SEARCH("Total",$E$1:$EE$1)))*(ISE RR(SEARCH("ABS",$E$1:$EE$1)))*(ISERR(SEARCH("lunch ",$E$1:$EE$1)))*(ISERR(SEARCH("ZZ",$E$1:$EE$1)))*E 2:EE2)),0)

What do I need to do to get this working? I've tried replacing the formula
after "MyFormula", but it doesn't work.

"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.

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.

I haven't followed this thread, but VBA offers a few Trim functions that may be
useful:

LTrim
RTrim
Trim (does the same as ltrim(rtrim(...))
and
application.trim() (which will change duplicate internal spaces to a single
space, as well as the right and left hand spaces.



Joel wrote:

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.

--

Dave Peterson

Thanks for all the great help Joel!

"Joel" wrote:

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.