Hi,

I've new to this VBA stuff, however with my limited knowledge have I
made a macro which adds cells and delete cells depeding on the text in
the first cell of the row.

My main problem is that it takes ages, as my spreadsheet have 25.000
rows.
I guess it would become quicker if I sorted all rows on the first cell,
then marked all rows including "AP" in first cell and then add the cell
needed.

Would it be possible to get this macro time down to a minute or two
instead of 60+ which is it now.

Thanks guys.


The macro:

Sub IfLetterThen()

Application.ScreenUpdating = False

For i = 1 To 100

If IsEmpty(ActiveCell) = False Then

' 2003

If ActiveCell = "AP" Then

ActiveCell.Offset(0, 14).Range("A1").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -14).Range("A1").Select



ElseIf ActiveCell = "GL" Then
ActiveCell.Offset(0, 12).Range("A1").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -12).Range("A1").Select


End If
End If

ActiveCell.Offset(1, 0).Select

Next i

Application.ScreenUpdating = True

End Sub


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Ctech,

You need to explain what you want to do a little bit more. Why are you only looping through 100
times? Is your worksheet a single data table, or a number of data tables whose structure would be
damaged if the whole sheet were sorted?

HTH,
Bernie
MS Excel MVP


"Ctech" wrote in message
...

Hi,

I've new to this VBA stuff, however with my limited knowledge have I
made a macro which adds cells and delete cells depeding on the text in
the first cell of the row.

My main problem is that it takes ages, as my spreadsheet have 25.000
rows.
I guess it would become quicker if I sorted all rows on the first cell,
then marked all rows including "AP" in first cell and then add the cell
needed.

Would it be possible to get this macro time down to a minute or two
instead of 60+ which is it now.

Thanks guys.


The macro:

Sub IfLetterThen()

Application.ScreenUpdating = False

For i = 1 To 100

If IsEmpty(ActiveCell) = False Then

' 2003

If ActiveCell = "AP" Then

ActiveCell.Offset(0, 14).Range("A1").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -14).Range("A1").Select



ElseIf ActiveCell = "GL" Then
ActiveCell.Offset(0, 12).Range("A1").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -12).Range("A1").Select


End If
End If

ActiveCell.Offset(1, 0).Select

Next i

Application.ScreenUpdating = True

End Sub


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Im counting just the first 100 because its just for testing purposes..
so 100 will be changed to the total number of rows in the sheet. ( I
need to add a count rows, too)

The macro isn't perfectly right at the moment!!

I want the macro to go through the whole spreadsheet and give all rows
the same number of columns. As it all is to be changed into a
pivottable later.

In my spreadsheet, all lines starting with "AP" have a row to much and
all starting with GL have one column to little. (So this is what my
macro mainly have to do something with)


Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Ctechm

Try the macro below, which sorts to get like values together. It will speed it up considerably.

I think I got your logic correct, but try it first on a copy of your data.

Note that the table could be resorted as a final step - you would need to determine the sort basis,
though.

HTH,
Bernie
MS Excel MVP

Sub IfLetterThen()
Dim myRows As Long
Range("A1").EntireColumn.Insert

'Find AP and delete extra column
Range("A1").FormulaR1C1 = _
"=IF(RC[1]=""AP"",""SortLow"",""SortHigh"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="SortLow", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 14).Delete Shift:=xlToLeft

'Find GL and insert extra column
Range("A1").FormulaR1C1 = _
"=IF(RC[1]=""GL"",""SortLow"",""SortHigh"")"
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="SortLow", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 12).Insert Shift:=xlToRight
Range("A1").EntireColumn.Delete
End Sub


"Ctech" wrote in message
...

Im counting just the first 100 because its just for testing purposes..
so 100 will be changed to the total number of rows in the sheet. ( I
need to add a count rows, too)

The macro isn't perfectly right at the moment!!

I want the macro to go through the whole spreadsheet and give all rows
the same number of columns. As it all is to be changed into a
pivottable later.

In my spreadsheet, all lines starting with "AP" have a row to much and
all starting with GL have one column to little. (So this is what my
macro mainly have to do something with)


Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

In light of your other statements, change

Range("A1").FormulaR1C1 = _
"=IF(RC[1]=""AP"",""SortLow"",""SortHigh"")"

to

Range("A1").FormulaR1C1 = _
"=IF(LEFT(RC[1],2)=""AP"",""SortLow"",""SortHigh"")"

Same for the GL line....

HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Ctechm

Try the macro below, which sorts to get like values together. It will speed it up considerably.

I think I got your logic correct, but try it first on a copy of your data.

Note that the table could be resorted as a final step - you would need to determine the sort
basis, though.

HTH,
Bernie
MS Excel MVP

Sub IfLetterThen()
Dim myRows As Long
Range("A1").EntireColumn.Insert

'Find AP and delete extra column
Range("A1").FormulaR1C1 = _
"=IF(RC[1]=""AP"",""SortLow"",""SortHigh"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="SortLow", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 14).Delete Shift:=xlToLeft

'Find GL and insert extra column
Range("A1").FormulaR1C1 = _
"=IF(RC[1]=""GL"",""SortLow"",""SortHigh"")"
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="SortLow", After:=Range("A1")).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 12).Insert Shift:=xlToRight
Range("A1").EntireColumn.Delete
End Sub


"Ctech" wrote in message
...

Im counting just the first 100 because its just for testing purposes..
so 100 will be changed to the total number of rows in the sheet. ( I
need to add a count rows, too)

The macro isn't perfectly right at the moment!!

I want the macro to go through the whole spreadsheet and give all rows
the same number of columns. As it all is to be changed into a
pivottable later.

In my spreadsheet, all lines starting with "AP" have a row to much and
all starting with GL have one column to little. (So this is what my
macro mainly have to do something with)


Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Bernie Deitric

You are a legend, thanks it works perfect and takes like 5 sec to
do...

I have the VBA Excel macroes for Dummies, do you have a more advanced
book which you would recommend?


Again Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Ctech,

You are a legend

Only in my own mind ;-)

I have the VBA Excel macroes for Dummies, do you have a more advanced
book which you would recommend?

A good next step is John Walkenbach's Excel 2003 Power Programming With VBA. Also written for
earlier versions, though not much changes between versions, so any book in that series is good.

HTH,
Bernie
MS Excel MVP

Is there now way to speed this up?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

I didn't try this on a range as big as yours (25k rows) but it worked on
1000 rows quickly.

Select the range that includes the APs and GLs, like A1:A25000, and then run
this:

Option Compare Text

Dim DelRg As Range

Sub DelCells()
Dim Cell As Range
Set DelRg = Nothing
For Each Cell In Selection.SpecialCells(xlCellTypeConstants)
If Cell.Value = "AP" Then
AddToUnion Cell.Offset(0, 14)
ElseIf Cell.Value = "GL" Then
AddToUnion Cell.Offset(0, 12)
End If
Next
If Not DelRg Is Nothing Then DelRg.Delete xlToLeft
End Sub

Sub AddToUnion(Cell As Range)
If DelRg Is Nothing Then
Set DelRg = Cell
Else
Set DelRg = Union(DelRg, Cell)
End If
End Sub


--
Jim
"Ctech" wrote in
message ...
|
| Hi,
|
| I've new to this VBA stuff, however with my limited knowledge have I
| made a macro which adds cells and delete cells depeding on the text in
| the first cell of the row.
|
| My main problem is that it takes ages, as my spreadsheet have 25.000
| rows.
| I guess it would become quicker if I sorted all rows on the first cell,
| then marked all rows including "AP" in first cell and then add the cell
| needed.
|
| Would it be possible to get this macro time down to a minute or two
| instead of 60+ which is it now.
|
| Thanks guys.
|
|
| The macro:
|
| Sub IfLetterThen()
|
| Application.ScreenUpdating = False
|
| For i = 1 To 100
|
| If IsEmpty(ActiveCell) = False Then
|
| ' 2003
|
| If ActiveCell = "AP" Then
|
| ActiveCell.Offset(0, 14).Range("A1").Select
| Selection.Delete Shift:=xlToLeft
| ActiveCell.Offset(0, -14).Range("A1").Select
|
|
|
| ElseIf ActiveCell = "GL" Then
| ActiveCell.Offset(0, 12).Range("A1").Select
| Selection.Delete Shift:=xlToLeft
| ActiveCell.Offset(0, -12).Range("A1").Select
|
|
| End If
| End If
|
| ActiveCell.Offset(1, 0).Select
|
| Next i
|
| Application.ScreenUpdating = True
|
| End Sub
|
|
| --
| Ctech
| ------------------------------------------------------------------------
| Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
| View this thread: http://www.excelforum.com/showthread...hreadid=472537
|

Thanks, Im working on it now..


Let say the Cell contains i.e AP JGLP, and I want this to be considered
as AP by the macro. Is there a way to write Cell.Value = "AP %"
where % means random letters?

If Cell.Value = "AP" Then
AddToUnion Cell.Offset(0, 14)


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Thanks your macro works, however I want to add a column for GL and not
delete one like your macro do. Could you help me fix this. Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

Sub DelCells()
Dim DelRg As Range
Dim DelRg1 As Range
Dim Cell As Range
Set DelRg = Nothing
Set DelRg1 = Nothing
For Each Cell In Selection.SpecialCells(xlCellTypeConstants)
If Cell.Value Like "AP*" Then
AddToUnion Cell.Offset(0, 14), DelRg
ElseIf Cell.Value Like "GL*" Then
AddToUnion Cell.Offset(0, 12), DelRg1
End If
Next
If Not DelRg Is Nothing Then DelRg.Delete xlToLeft
If Not DelRg1 Is Nothing Then DelRg1.Insert Shift:=xlShiftToRight

End Sub

Sub AddToUnion(Cell As Range, rng As Range)
If rng Is Nothing Then
Set rng = Cell
Else
Set rng = Union(rng, Cell)
End If
End Sub

--
Regards,
Tom Ogilvy


"Ctech" wrote in
message ...

Thanks your macro works, however I want to add a column for GL and not
delete one like your macro do. Could you help me fix this. Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537

if cell.Value like "AP*" Then

or

if left(cell.Value,2) = "AP" then

--
Regards,
Tom Ogilvy

"Ctech" wrote in
message ...

Thanks, Im working on it now..


Let say the Cell contains i.e AP JGLP, and I want this to be considered
as AP by the macro. Is there a way to write Cell.Value = "AP %"
where % means random letters?

If Cell.Value = "AP" Then
AddToUnion Cell.Offset(0, 14)


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=472537