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"))
- Per
"Jack Sons" <
[email protected]> skrev i meddelelsen
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
" & 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 -
