copying some rows and columns

J

Jack Sons

Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an "x".
Formats, text colors and interior colors are also to be copied.

Due to clumsy code (sorry for that) I can't change the order of the columns
in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your assistance will
be appreciated.

Jack Sons
The Netherlands
 
P

Per Jessen

Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1, Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per
 
J

Jack Sons

Per,

Thank you. So much of my own clumsy code I can now discard! I really learned
a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns mentioned to
the destination sheet and I do not want the textboxes that exist in row 1 of
the targetsheet to be copied to the destination sheet?

Jack.
 
P

Per Jessen

Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in row 1, the
textbox will not be copied, neither will the content of the textbox.

You can place the content of the textbox in the underlying cell. To do that,
enter design mode, and right click a textbox > Properties > Find LinkedCell
property, and enter the cell address, eg. A1, then you just change the code
to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
....
Per
 
J

Jack Sons

Per,
If you change the code to copy row 1 also and paste starting in row 1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.
 
P

Per Jessen

Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per
 
J

Jack Sons

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown below
(hope it will show after sending it over internet, colors are red for the
first four dates, black for the following three and blue for the last five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009


Thank you in advance Per.

Jack.
 
P

Per Jessen

Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per
 
J

Jack Sons

Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your code
and mine look the same!
If I did, can you make your code do for placing dates in column K equal to
what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue and
bold. (later on I filter out the superfluous rows, that is those rows where
in column DM is "x", see my first post that you answered). Notice that in
the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master the
for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per
 
P

Per Jessen

Jack,

Your code do not look to bad, but you do not need to use .Select when you
manipulate a cell. I removed all select statements, and then it looks like
this (the Calculate statement is only needed if you use manual calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending, Key2:=Range("I2")
_
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending, header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future date
in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for primary
sort key, then I use Column K as secondary sort key.

Regards,
Per


Jack Sons said:
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your
code and mine look the same!
If I did, can you make your code do for placing dates in column K equal to
what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue and
bold. (later on I filter out the superfluous rows, that is those rows
where in column DM is "x", see my first post that you answered). Notice
that in the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master
the for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown below
(hope it will show after sending it over internet, colors are red for the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


























- Vis tekst i anførselstegn -
 
J

Jack Sons

Per,

Thank you for your advice.

Until now column J is most future, but in some cases column I could have
the most future date. Can you fix that?

Another question. I need column P to hold colA&colB&colK but colK in the
format dmmmmyyyy (so without leading zero and without spaces. In A are names
(without spaces) and in B alpanumerical info like AHF-03-06.4, also without
spaces.
In my case P2 for example would be MombargSHBD2-03-0508oktober2009 (Mombarg
in A, .SHBD2-02-05 in B and originally 8 oktober 2009 in K). Just black, not
bold.
I need this only if the corresponding K-cell is in red and bold. Can it be
done in an easy way with your (slightly modified) code?

Jack.



Per Jessen said:
Jack,

Your code do not look to bad, but you do not need to use .Select when you
manipulate a cell. I removed all select statements, and then it looks like
this (the Calculate statement is only needed if you use manual
calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending, header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future date
in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


Jack Sons said:
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your
code and mine look the same!
If I did, can you make your code do for placing dates in column K equal
to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue and
bold. (later on I filter out the superfluous rows, that is those rows
where in column DM is "x", see my first post that you answered). Notice
that in the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master
the for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown below
(hope it will show after sending it over internet, colors are red for
the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in row
1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in row
1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell. To
do
that, enter design mode, and right click a textbox > Properties >
Find
LinkedCell property, and enter the cell address, eg. A1, then you
just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the textboxes
that
exist in row 1 of the targetsheet to be copied to the destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1, Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be copied.

Due to clumsy code (sorry for that) I can't change the order of
the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

Per,

It occurred to me that column H could have a more future date than in the
date in the corresponding cells of I or J. In that case the H-date should be
in K, but in black and regular. You see, red in K means an action date for
me. A date in H is not an action date for me, even if it is more future than
I or J (I and J in that case wil be dates that already are in the past).
Can you fix that also?

Jack.

Per Jessen said:
Jack,

Your code do not look to bad, but you do not need to use .Select when you
manipulate a cell. I removed all select statements, and then it looks like
this (the Calculate statement is only needed if you use manual
calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending, header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future date
in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


Jack Sons said:
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your
code and mine look the same!
If I did, can you make your code do for placing dates in column K equal
to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue and
bold. (later on I filter out the superfluous rows, that is those rows
where in column DM is "x", see my first post that you answered). Notice
that in the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master
the for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown below
(hope it will show after sending it over internet, colors are red for
the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in row
1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in row
1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell. To
do
that, enter design mode, and right click a textbox > Properties >
Find
LinkedCell property, and enter the cell address, eg. A1, then you
just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the textboxes
that
exist in row 1 of the targetsheet to be copied to the destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1, Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be copied.

Due to clumsy code (sorry for that) I can't change the order of
the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
P

Per Jessen

Jack,

My code is already made, so it will only make the date red if it is fond in
colum I or J. The challenge is your formula. If we go back and use my
original formula, it will always find the most future date, and the code
will color it as required. I am not sure if this is needed.

Insert the code below before 'Columns("L").Clear' to fill P2 and down:

Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown

Regards,
Per

Jack Sons said:
Per,

It occurred to me that column H could have a more future date than in the
date in the corresponding cells of I or J. In that case the H-date should
be in K, but in black and regular. You see, red in K means an action date
for me. A date in H is not an action date for me, even if it is more
future than I or J (I and J in that case wil be dates that already are in
the past).
Can you fix that also?

Jack.

Per Jessen said:
Jack,

Your code do not look to bad, but you do not need to use .Select when you
manipulate a cell. I removed all select statements, and then it looks
like this (the Calculate statement is only needed if you use manual
calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future
date in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


Jack Sons said:
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your
code and mine look the same!
If I did, can you make your code do for placing dates in column K equal
to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue
and bold. (later on I filter out the superfluous rows, that is those
rows where in column DM is "x", see my first post that you answered).
Notice that in the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master
the for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"), Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown below
(hope it will show after sending it over internet, colors are red for
the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in row
1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in row
1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell. To
do
that, enter design mode, and right click a textbox > Properties >
Find
LinkedCell property, and enter the cell address, eg. A1, then you
just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the textboxes
that
exist in row 1 of the targetsheet to be copied to the destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1, Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be copied.

Due to clumsy code (sorry for that) I can't change the order of
the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !

I saw your code Range("A2:L" & LastRow).

How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.

Jack.

Per Jessen said:
Jack,

My code is already made, so it will only make the date red if it is fond
in colum I or J. The challenge is your formula. If we go back and use my
original formula, it will always find the most future date, and the code
will color it as required. I am not sure if this is needed.

Insert the code below before 'Columns("L").Clear' to fill P2 and down:

Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown

Regards,
Per

Jack Sons said:
Per,

It occurred to me that column H could have a more future date than in the
date in the corresponding cells of I or J. In that case the H-date should
be in K, but in black and regular. You see, red in K means an action date
for me. A date in H is not an action date for me, even if it is more
future than I or J (I and J in that case wil be dates that already are in
the past).
Can you fix that also?

Jack.

Per Jessen said:
Jack,

Your code do not look to bad, but you do not need to use .Select when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future
date in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the code
below the dotted line I did - I think - something slightly different
regarding putting a date in column K. Or didn't I? The results of your
code and mine look the same!
If I did, can you make your code do for placing dates in column K equal
to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold, "x"
where it should be black and regular and blank where it shoud be blue
and bold. (later on I filter out the superfluous rows, that is those
rows where in column DM is "x", see my first post that you answered).
Notice that in the lower half of my code VANDAAG is Dutch for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet master
the for ... next loop. But it worked also! (does it look very bad?)

Thanks again for your help Per. Hope you will help me again when I have
additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there
are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to the
dates in column K

So column K will look like a red, blach and blue flag, like shown
below
(hope it will show after sending it over internet, colors are red for
the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in
row 1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in
row 1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell.
To do
that, enter design mode, and right click a textbox > Properties >
Find
LinkedCell property, and enter the cell address, eg. A1, then you
just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the
textboxes that
exist in row 1 of the targetsheet to be copied to the destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1, Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be copied.

Due to clumsy code (sorry for that) I can't change the order of
the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
P

Per Jessen

Two options:

Range("A" & LastRow & ":L" & LastRow+100)

Range(Cells(LastRow,1), Cells(LastRow+100,"L"))

- Per

Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !

I saw your code Range("A2:L" & LastRow).

How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.

Jack.

Per Jessen said:
Jack,

My code is already made, so it will only make the date red if it is fond
in colum I or J. The challenge is your formula. If we go back and use my
original formula, it will always find the most future date, and the code
will color it as required. I am not sure if this is needed.

Insert the code below before 'Columns("L").Clear' to fill P2 and down:

Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown

Regards,
Per

Jack Sons said:
Per,

It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if it
is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

Your code do not look to bad, but you do not need to use .Select when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future
date in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is Dutch
for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look very
bad?)

Thanks again for your help Per. Hope you will help me again when I
have additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there
are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to the
dates in column K
the rows with a ragular and black date in column K sorted ascending
to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to
the
dates in column K

So column K will look like a red, blach and blue flag, like shown
below
(hope it will show after sending it over internet, colors are red for
the
first four dates, black for the following three and blue for the last
five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in
row 1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in
row 1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell.
To do
that, enter design mode, and right click a textbox > Properties >
Find
LinkedCell property, and enter the cell address, eg. A1, then you
just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the
textboxes that
exist in row 1 of the targetsheet to be copied to the
destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1,
Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and
further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be
copied.

Due to clumsy code (sorry for that) I can't change the order
of the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

Per,

Thanks for your many advice, it really helped me a lot.

Jack.

Per Jessen said:
Two options:

Range("A" & LastRow & ":L" & LastRow+100)

Range(Cells(LastRow,1), Cells(LastRow+100,"L"))

- Per

Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !

I saw your code Range("A2:L" & LastRow).

How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.

Jack.

Per Jessen said:
Jack,

My code is already made, so it will only make the date red if it is
fond in colum I or J. The challenge is your formula. If we go back and
use my original formula, it will always find the most future date, and
the code will color it as required. I am not sure if this is needed.

Insert the code below before 'Columns("L").Clear' to fill P2 and down:

Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if
it is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

Your code do not look to bad, but you do not need to use .Select when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future
date in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is Dutch
for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look very
bad?)

Thanks again for your help Per. Hope you will help me again when I
have additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there
are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to
the
dates in column K
the rows with a ragular and black date in column K sorted ascending
to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to
the
dates in column K

So column K will look like a red, blach and blue flag, like shown
below
(hope it will show after sending it over internet, colors are red
for the
first four dates, black for the following three and blue for the
last five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in
row 1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in
row 1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell.
To do
that, enter design mode, and right click a textbox > Properties
Find
LinkedCell property, and enter the cell address, eg. A1, then
you just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the
textboxes that
exist in row 1 of the targetsheet to be copied to the
destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1,
Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and
further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be
copied.

Due to clumsy code (sorry for that) I can't change the order
of the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

Per,

Code like below I use frequently. I think many lines may be superfluous,
especially the "with ... end with" parts. Can it be made more compact and -
that's the important point - will it make the code somewhat faster? E.g .
because the borders are "normal", could I leave all border statements out?

Jack.

If Range(Cells(commentrij, 48), Cells(commentrij, 48)).Text = "x" Then
Range(Cells(commentrij, 1), Cells(commentrij, 58)).Select
Selection.Interior.ColorIndex = xlNone
With Selection.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With


Per Jessen said:
Two options:

Range("A" & LastRow & ":L" & LastRow+100)

Range(Cells(LastRow,1), Cells(LastRow+100,"L"))

- Per

Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !

I saw your code Range("A2:L" & LastRow).

How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.

Jack.

Per Jessen said:
Jack,

My code is already made, so it will only make the date red if it is
fond in colum I or J. The challenge is your formula. If we go back and
use my original formula, it will always find the most future date, and
the code will color it as required. I am not sure if this is needed.

Insert the code below before 'Columns("L").Clear' to fill P2 and down:

Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if
it is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

Your code do not look to bad, but you do not need to use .Select when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):

Sub jack2()
Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub

Just curious does your macro sort correct if you have the most future
date in column J?

No problem using your formula in my code, just replace:

Range("K2").Formula = "=Max(D2:J2)"

With:

Range("K2").FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

and insert the statement below to format column K.

Columns("K:K").NumberFormat = "d mmmm yyyy"

You can always come back for further help.

As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.

Regards,
Per


"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thanks again.

Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?

In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is Dutch
for TODAY.

Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look very
bad?)

Thanks again for your help Per. Hope you will help me again when I
have additional questions.

Jack.

--------------------------------------------------------------------------------------------------------------------

Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _

"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"

Range("L2").Select
ActiveCell.FormulaR1C1 = _

"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select

Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"

Calculate

Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With


"Per Jessen" <[email protected]> schreef in bericht
Jack,

You can improve the previous code a bit further:

With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With


I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:

Sub Jack()
Dim LastRow As Long
Dim cell As Range

Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear
Range("K2").Formula = "=Max(D2:J2)"
Range("K2:K" & LastRow).FillDown
For Each cell In Range("K2:K" & LastRow).Cells
If cell.Value < Date Then
cell.Font.Bold = True
cell.Font.ColorIndex = 5
cell.Offset(0, 1) = 3
ElseIf cell.Value = cell.Offset(0, -1) Or _
cell.Value = cell.Offset(0, -2) Then
With cell
.Font.Bold = True
.Font.ColorIndex = 3
.Offset(0, 1) = 1
End With
Else
cell.Offset(0, 1) = 2
End If
Next
Range("A2:L" & LastRow).Sort Key1:=Range("L2"), _
Order1:=xlAscending, Key2:=Range("K2"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Columns("L").Clear
Application.Screenupdating=True
End Sub

-Per

Yes Per, I used that, thanks.

Now I would like to use nice compact and fast executing code for the
following complex conditions.

Row 1 contains headers.
Cells in colums D to J (from row 2 downwards, as far below as there
are
names in column A) contain dates or nothing.

In each row I want in column K the "highest" (most future) date but
in bold and red if it is a future date of colums I or J
in regular and black if is a future date of colums D to H
in bold and blue if it is a date in the past

and

the rows with a bold and red date in column K sorted ascending to
the
dates in column K
the rows with a ragular and black date in column K sorted ascending
to
the dates in column K
the rows with a bold and blue date in column K sorted ascending to
the
dates in column K

So column K will look like a red, blach and blue flag, like shown
below
(hope it will show after sending it over internet, colors are red
for the
first four dates, black for the following three and blue for the
last five).

8 oktober 2009

14 oktober 2009

9 november 2009

11 november 2009

7 oktober 2009

9 oktober 2009

9 oktober 2009

28 augustus 2009

22 september 2009

25 september 2009

30 september 2009

30 september 2009

Thank you in advance Per.

Jack.

"Per Jessen" <[email protected]> schreef in
bericht


Jack,

You are close, but no need to select the shapes:

DestSh.Shapes("resteert").Delete
DestSh.Shapes("betaald").Delete
DestSh.Shapes("legenda_1").Delete
DestSh.Shapes("L").Delete

Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

If you change the code to copy row 1 also and paste starting in
row 1

I did this

With TargetSh
.Range("DM1:DM" & eindrij).AutoFilter field:=1, Criteria1:="<>x"
.Range("A1:C" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")
.Range("F1:F" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N1")
.Range("AA1:AA" & eindrij).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O1")
...
.Range("DM1:DM" & eindrij).AutoFilter
End With

but then the text boxes come with the cells of row 1 of TargetSh.
I got rid of them with

DestSh.Shapes("resteert").Select
Selection.Delete
DestSh.Shapes("betaald").Select
Selection.Delete
DestSh.Shapes("legenda_1").Select
Selection.Delete
DestSh.Shapes("L").Select
Selection.Delete

which is rather clumsy, I'm afraid (better: I'm sure).

What now?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Jack,

I am glad you learned a bit from my code.

If you change the code to copy row 1 also and paste starting in
row 1,
the textbox will not be copied, neither will the content of the
textbox.

You can place the content of the textbox in the underlying cell.
To do
that, enter design mode, and right click a textbox > Properties
Find
LinkedCell property, and enter the cell address, eg. A1, then
you just
change the code to copy/paste starting at row 1

.Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A1")

Hopes this helps.
...
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Per,

Thank you. So much of my own clumsy code I can now discard! I
really
learned a thing or two (or more)!

What if I also want to bring the cells in row 1 of the columns
mentioned to the destination sheet and I do not want the
textboxes that
exist in row 1 of the targetsheet to be copied to the
destination
sheet?

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi

I think this is what you need:

Sub aaa()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set DestSh = Worksheets("Sheet2")
LastRow = 252
With TargetSh
.Range("DM1:DM" & LastRow).AutoFilter field:=1,
Criteria1:="<>x"
.Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("A2")
.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("N2")
.Range("AA2:AA" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("O2")
.Range("AK2:AL" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("D2")
.Range("AM2:AM" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("G2")
.Range("AN2:AN" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("F2")
.Range("AO2:AO" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("J2")
.Range("AP2:AP" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("H2")
.Range("AR2:AR" &
LastRow).SpecialCells(xlCellTypeVisible).Copy
DestSh.Range("I2")
.Range("DM1:DM" & LastRow).AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Jack Sons" <[email protected]> skrev i meddelelsen
Hi all,

Of sheet 1, rows 2 tot 252 and columns A to AR I want to copy

columns A to C to sheet 2 colums A to C rows 2 and further,
column D to sheet 2 colum N rows 2 and further,
column AA to sheet 2 column O rows 2 and further,
columns AK and AL to sheet 2 colums D and E rows 2 and
further,
column AM to sheet 2 column G rows 2 and further,
column AN to sheet 2 column F rows 2 and further,
column AO to sheet 2 column J rows 2 and further,
column AP to sheet 2 column H rows 2 and further,
column AR to sheet 2 column I rows 2 and further,

and all that only for those rows where in column DM is not an
"x".
Formats, text colors and interior colors are also to be
copied.

Due to clumsy code (sorry for that) I can't change the order
of the
columns in sheet 1 without getting an awful lot of trouble.

I'm looking for nice compact and fast executing code, your
assistance
will be appreciated.

Jack Sons
The Netherlands- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
P

Per Jessen

Hi Jack,

If your code do not change the borders, you can delete all 'border'
statements. With statemens are a good and fast construction, if you
have to do multiple things with an object.

As I have mentioned before, you should avoid 'Select' statements, as
your code is faster without. In this case I would use a Range object.

Dim FormatRange As Range
If Cells(commentrij, 48).Text = "x" Then
Set FormatRange = Range(Cells(commentrij, 1), Cells(commentrij,
58))
FormatRange.Interior.ColorIndex = xlNone
With FormatRange.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With FormatRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

Regards,
Per

Per,

Code like below I use frequently. I think many lines may be superfluous,
especially the "with ... end with" parts. Can it be made more compact and-
that's the important point - will it make the code somewhat faster? E.g .
because the borders are "normal", could I leave all border statements out?

Jack.

If Range(Cells(commentrij, 48), Cells(commentrij, 48)).Text = "x" Then
    Range(Cells(commentrij, 1), Cells(commentrij, 58)).Select
    Selection.Interior.ColorIndex = xlNone
    With Selection.Interior
        .Pattern = xlHorizontal
        .PatternColorIndex = 4 'lichtgroen
    End With
        With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With

"Per Jessen" <[email protected]> schreef in bericht

Two options:
Range("A" & LastRow & ":L" & LastRow+100)
Range(Cells(LastRow,1), Cells(LastRow+100,"L"))
Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !
I saw your code     Range("A2:L" & LastRow).
How if I want to do     Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
My code is already made, so it will only make the date red  if it is
fond in colum I or J. The challenge is your formula. If we go back and
use my original formula, it will always find the most future date, and
the code will color it as required. I am not sure if this is needed.
Insert the code below before 'Columns("L").Clear'  to fill P2 and down:
Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
   LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if
it is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
Your code do not look to bad, but you do not need to use .Select when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):
Sub jack2()
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
   , Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
   xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
With Columns("K:K")
   .FormatConditions.Delete
   .FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
   With .FormatConditions(1).Font
       .Bold = True
       .Italic = False
       .ColorIndex = 3
   End With
   .FormatConditions.Add Type:=xlExpression, Formula1:= _
       "=$K1<=VANDAAG()"
   With .FormatConditions(2).Font
       .Bold = True
       .Italic = False
       .ColorIndex = 5
   End With
End With
End Sub
Just curious does your macro sort correct if you have the most future
date in column J?
No problem using your formula in my code, just replace:
Range("K2").Formula = "=Max(D2:J2)"
With:
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
and insert the statement below to format column K.
Columns("K:K").NumberFormat = "d mmmm yyyy"
You can always come back for further help.
As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
Thanks again.
Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?
In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is Dutch
for TODAY.
Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look very
bad?)
Thanks again for your help Per. Hope you will help me again when I
have additional questions.
Jack.
---------------------------------------------------------------------------­-----------------------------------------
   Range("K2").Select
   Application.CutCopyMode = False
   ActiveCell.FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
   Range("L2").Select
   ActiveCell.FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
   Range("K2:L2").Select
   Application.CutCopyMode = False
   Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
   Range("K2:L252").Select
       Columns("K:K").Select
   Selection.NumberFormat = "d mmmm yyyy"
   Calculate
   Range("A2").Select
   Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
       , Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
       xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
               Columns("K:K").Select
   Selection.FormatConditions.Delete
   Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
   With Selection.FormatConditions(1).Font
       .Bold = True
       .Italic = False
       .ColorIndex = 3
   End With
   Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
       "=$K1<=VANDAAG()"
   With Selection.FormatConditions(2).Font
       .Bold = True
       .Italic = False
       .ColorIndex = 5
   End With
"Per Jessen" <[email protected]> schreef in bericht
Jack,
You can improve the previous code a bit further:
With DestSh
   .Shapes("resteert").Delete
   .Shapes("betaald").Delete
   .Shapes("legenda_1").Delete
   .Shapes("L").Delete
End With
I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:
Sub Jack()
Dim LastRow As Long
Dim cell As Range
Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear

...

læs mere »- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

I got it, thanks Per.

Jack.

"Per Jessen" <[email protected]> schreef in bericht
Hi Jack,

If your code do not change the borders, you can delete all 'border'
statements. With statemens are a good and fast construction, if you
have to do multiple things with an object.

As I have mentioned before, you should avoid 'Select' statements, as
your code is faster without. In this case I would use a Range object.

Dim FormatRange As Range
If Cells(commentrij, 48).Text = "x" Then
Set FormatRange = Range(Cells(commentrij, 1), Cells(commentrij,
58))
FormatRange.Interior.ColorIndex = xlNone
With FormatRange.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With FormatRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

Regards,
Per

Per,

Code like below I use frequently. I think many lines may be superfluous,
especially the "with ... end with" parts. Can it be made more compact
and -
that's the important point - will it make the code somewhat faster? E.g .
because the borders are "normal", could I leave all border statements out?

Jack.

If Range(Cells(commentrij, 48), Cells(commentrij, 48)).Text = "x" Then
Range(Cells(commentrij, 1), Cells(commentrij, 58)).Select
Selection.Interior.ColorIndex = xlNone
With Selection.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

"Per Jessen" <[email protected]> schreef in
bericht

Two options:
Range("A" & LastRow & ":L" & LastRow+100)
Range(Cells(LastRow,1), Cells(LastRow+100,"L"))
Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !
I saw your code Range("A2:L" & LastRow).
How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
My code is already made, so it will only make the date red if it is
fond in colum I or J. The challenge is your formula. If we go back and
use my original formula, it will always find the most future date, and
the code will color it as required. I am not sure if this is needed.
Insert the code below before 'Columns("L").Clear' to fill P2 and down:
Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the
H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if
it is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
Your code do not look to bad, but you do not need to use .Select
when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):
Sub jack2()
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub
Just curious does your macro sort correct if you have the most
future
date in column J?
No problem using your formula in my code, just replace:
Range("K2").Formula = "=Max(D2:J2)"
With:
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
and insert the statement below to format column K.
Columns("K:K").NumberFormat = "d mmmm yyyy"
You can always come back for further help.
As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
Thanks again.
Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?
In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud
be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is
Dutch
for TODAY.
Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look
very
bad?)
Thanks again for your help Per. Hope you will help me again when I
have additional questions.
Jack.
---------------------------------------------------------------------------­-----------------------------------------
Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
"Per Jessen" <[email protected]> schreef in bericht
Jack,
You can improve the previous code a bit further:
With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With
I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:
Sub Jack()
Dim LastRow As Long
Dim cell As Range
Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear

...

læs mere »- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 
J

Jack Sons

Per,

The code below causes all four borders of each cell in the range to
disappear.

With Selection.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4
End With

If I want them to be like in other cells (hairline, black) I need four
sections of code, one each for upper, lower, right and left borders.

I know that this (the "All" part !) does not exist:

With FormatRange.Borders(xlEdgeAll)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

Is there another possibility?

Jack.


"Per Jessen" <[email protected]> schreef in bericht
Hi Jack,

If your code do not change the borders, you can delete all 'border'
statements. With statemens are a good and fast construction, if you
have to do multiple things with an object.

As I have mentioned before, you should avoid 'Select' statements, as
your code is faster without. In this case I would use a Range object.

Dim FormatRange As Range
If Cells(commentrij, 48).Text = "x" Then
Set FormatRange = Range(Cells(commentrij, 1), Cells(commentrij,
58))
FormatRange.Interior.ColorIndex = xlNone
With FormatRange.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With FormatRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

Regards,
Per

Per,

Code like below I use frequently. I think many lines may be superfluous,
especially the "with ... end with" parts. Can it be made more compact
and -
that's the important point - will it make the code somewhat faster? E.g .
because the borders are "normal", could I leave all border statements out?

Jack.

If Range(Cells(commentrij, 48), Cells(commentrij, 48)).Text = "x" Then
Range(Cells(commentrij, 1), Cells(commentrij, 58)).Select
Selection.Interior.ColorIndex = xlNone
With Selection.Interior
.Pattern = xlHorizontal
.PatternColorIndex = 4 'lichtgroen
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

"Per Jessen" <[email protected]> schreef in
bericht

Two options:
Range("A" & LastRow & ":L" & LastRow+100)
Range(Cells(LastRow,1), Cells(LastRow+100,"L"))
Jack Sons said:
Works like a charm Per, thanks.
Of course I already abandoned my inefficient code with all those R1C1
formulas. Yours is sao much more elegant, efficient and fast !
I saw your code Range("A2:L" & LastRow).
How if I want to do Range("ALastrow:" & LLastRow+100).
Whatever I tried (with &, " etc.) I did not succeed.
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
My code is already made, so it will only make the date red if it is
fond in colum I or J. The challenge is your formula. If we go back and
use my original formula, it will always find the most future date, and
the code will color it as required. I am not sure if this is needed.
Insert the code below before 'Columns("L").Clear' to fill P2 and down:
Set f = Range("L2:L" & LastRow).Find(what:=2, After:=Range("L2"), _
LookIn:=xlValues, Lookat:=xlWhole)
MyFormula = "=A2 & B2 & Text(K2, ""d mmmm yyyy"")"
Range("P2").Formula = "=A2 & B2 & Text(K2, ""d mmmm åååå"")"
Range("P2:p" & f.Row - 1).FillDown
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
It occurred to me that column H could have a more future date than in
the date in the corresponding cells of I or J. In that case the
H-date
should be in K, but in black and regular. You see, red in K means an
action date for me. A date in H is not an action date for me, even if
it is more future than I or J (I and J in that case wil be dates that
already are in the past).
Can you fix that also?
Jack.
"Per Jessen" <[email protected]> schreef in bericht
Jack,
Your code do not look to bad, but you do not need to use .Select
when
you manipulate a cell. I removed all select statements, and then it
looks like this (the Calculate statement is only needed if you use
manual calculation):
Sub jack2()
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Columns("K:K").NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
With Columns("K:K")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
End With
End Sub
Just curious does your macro sort correct if you have the most
future
date in column J?
No problem using your formula in my code, just replace:
Range("K2").Formula = "=Max(D2:J2)"
With:
Range("K2").FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
and insert the statement below to format column K.
Columns("K:K").NumberFormat = "d mmmm yyyy"
You can always come back for further help.
As you see my macro put 1, 2 or 3 in column L which is only used for
primary sort key, then I use Column K as secondary sort key.
Regards,
Per
"Jack Sons" <[email protected]> skrev i meddelelsen
Per,
Thanks again.
Remarkable is that I also used column L as helper column. With the
code below the dotted line I did - I think - something slightly
different regarding putting a date in column K. Or didn't I? The
results of your code and mine look the same!
If I did, can you make your code do for placing dates in column K
equal to what I did with the first R1C1 formula below?
In column L my code put "xx" where a K-cell should be red and bold,
"x" where it should be black and regular and blank where it shoud
be
blue and bold. (later on I filter out the superfluous rows, that is
those rows where in column DM is "x", see my first post that you
answered). Notice that in the lower half of my code VANDAAG is
Dutch
for TODAY.
Your code is undeniable much more elegant than mine, I use rather
primitively looking code aid due to the fact that I did not yet
master the for ... next loop. But it worked also! (does it look
very
bad?)
Thanks again for your help Per. Hope you will help me again when I
have additional questions.
Jack.
---------------------------------------------------------------------------­-----------------------------------------
Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(MAX(RC[-5],RC[-3]:RC[-1])>0,MAX(RC[-5],RC[-3]:RC[-1]),IF(MAX(RC[-7]:RC­[-6],RC[-4])>0,MAX(RC[-7]:RC[-6],RC[-4]),""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(MAX(RC[-8]:RC[-7],RC[-6]),RC[-1]>TODAY()),""xx"",IF(OR(AND(RC[-1]<­>0,RC[-1]<TODAY()),RC[-1]=TODAY()),""x"",""""))"
Range("K2:L2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("K2:L252"),
Type:=xlFillDefault
Range("K2:L252").Select
Columns("K:K").Select
Selection.NumberFormat = "d mmmm yyyy"
Calculate
Range("A2").Select
Selection.Sort key1:=Range("L2"), order1:=xlDescending,
Key2:=Range("I2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Columns("K:K").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=en(OF($K1=$I1;$K1=$J1);$K1>VANDAAG())"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$K1<=VANDAAG()"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
"Per Jessen" <[email protected]> schreef in bericht
Jack,
You can improve the previous code a bit further:
With DestSh
.Shapes("resteert").Delete
.Shapes("betaald").Delete
.Shapes("legenda_1").Delete
.Shapes("L").Delete
End With
I do not hope you have any data in column L as it is used as helper
column in the macro below. I think this is what you asked for:
Sub Jack()
Dim LastRow As Long
Dim cell As Range
Application.Screenupdating=False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("K2:K" & rows.Count).Clear

...

læs mere »- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top