help with EXCEL SCRIPT

N

Nastech

hi, trying to get help with script for copying 4 data
column sections to backup / history positions.

1 col: DU to DT

22 col (main, 21 col back up), COPY: EE - EY,
Paste-Special-Values to right 1 col: EF - EZ

double columns (10 sets of 2), COPY: FE - FV,
Paste-Special-Values to right 2 cols: FG - FX

double columns (1 set of 2), COPY: EC - ED,
Paste-Special-Values to: FE - FF


the following is a copy of the script currently in use.


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Target.Row < 130 Then Exit Sub
If Me.Cells(.Row, "A").Value = "." Then Exit Sub
'add "+" to blank spaces col A:
If Not Intersect(Me.Range("a:a"), .Cells) Is Nothing Then
Application.EnableEvents = False
.Value = Replace(.Value, " ", "+")
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CK:CO"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination:
With Me.Cells(.Row, "CF")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CW:CW"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination
With Me.Cells(.Row, "CG")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
End With
End Sub
 
N

Nastech

hi, I have 4 different positions that I copy paste-values to a different
location, daily, for couple of main uses of reviewing old data/ comparing to
today's data..

if using script for moving data is possible.. would try to get a button
that would do the task, that is performed once per day. automating would
help keep mistakes down but would have a letter in a specific cell to be a
guard from hitting the button accidently. the old data is for percent change
and average calculations.

the column designations are as below. where sheet is somewhat mature from
need of add - subtract of columns, wonder if Script could still allow for
movement of column locations if need be, but that is of second concern. not
sure if anything else you need to know? thanks..
 
N

Nastech

since once per day.. don't know if important, but not concerned with how it
is done.. speed not important, if would need to be 1 step at a time anyways?
is fine..

if possible would like double guard: Cell: $DN$6="z",
if possible: (automatic) adjust of Columns & Cell: $DN$6 if other columns
/ items are moved.
 
S

Sheeloo

Test this out... You can assign it to a button...

It will execute only if A1 contains $.$OK$.$
Sub Macro1()
If Range("A1").Value = "$.$OK$.$" Then
'1 col: DU to DT
Columns("DU:DU").Select
Selection.Copy
Range("DT").Select
ActiveSheet.Paste
'22 col (main, 21 col back up), COPY: EE - EY,
'Paste-Special-Values to right 1 col: EF - EZ
Columns("EE:EY").Select
Selection.Copy
Range("EF1").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'double columns (10 sets of 2), COPY: FE - FV,
'Paste-Special-Values to right 2 cols: FG - FX
Columns("FE:FV").Select
Selection.Copy
Range("FG").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'double columns (1 set of 2), COPY: EC - ED,
'Paste-Special-Values to: FE - FF
Columns("EC:ED").Select
Selection.Copy
Range("FE").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End If
End Sub
 
N

Nastech

Thanks.., may take awhile for me to make work 1st time, then test;
but wonder if paste function will be VALUES ONLY. thanks.
(there is different Standard & Conditional Formatting in all locations)
 
S

Sheeloo

In one set you had NOT mentioned paste special so I took that out. You can
add it just like in other sets...

Test one set at a time... :)
 
N

Nastech

ha.. sorry-must be blind.. thank you very much for your help. got not much
else but some silly? formula's I put together, for payback :) if just to make
you see them. if find useful:

In document hyperlink:
(Cntrl-Alt-Enter, $aa$3 is number of rows showing in sheet, $a1026 is row
formula is in)

=HYPERLINK("#"&CELL("address",OFFSET($A$449,IF(ROW($A$449)>ROW($A1026)-$AA$3/4,$AA$3,-1),0)),"0")

Relative Position in % (lo - hi, works for time of day to output as well)
(last-fm)/(to-fm)*100, or *10 for single dig response

=IF(I1027=0,"",(EE1027-HG1027)/(HH1027-HG1027)*10)

=((MIN($EE$4,TIME(16,0,0))-"9:30")/("16:00"-"9:30"))*$AA$5
=((MIN($EE$4,"16:00")-"9:30")/("16:00"-"9:30"))*$AA$6
($ee$4: current time, $aa$5: preset level)


FIND MAX VALUE IN COLUMN, HYPERLINK TO IT
(big but works, cntrl-alt-enter, dj13 where formula resides)

=HYPERLINK(IF(ISNA(INDEX(ROW(DJ$179:DJ$1719)-ROW(DJ$179),
INDEX(ROW(DJ$179:DJ$1719),MATCH(MAX(DJ$179:DJ$1719),DJ$179:DJ$1719,0)))),""
"#"&CELL("address",OFFSET(INDIRECT(SUBSTITUTE(SUBSTITUTE(CELL("address",DJ13),"",""),ROW(),"")
INDEX(ROW(DJ$179:DJ$1719),MATCH(MAX(DJ$179:DJ$1719),DJ$179:DJ$1719,0))),$AA$3,0))),MAX(IF(ISNUMBER(DJ$179:DJ$1719),DJ$179:DJ$1719,-1E+100)))
 
N

Nastech

hi, I get a compile error, unexpected end sub, at the first line.

created button (novice), from excel help entered vb as directed,
exited design mode, on press button the first line hilites yellow.

script placed as follows:



Option Explicit
Private Sub CommandButton1_Click()
Sub Macro1()
If Range("DN6").Value = "Z" Then
'1 col: copy Paste-Values to left 1 col
Columns("DU:DU").Select
Selection.Copy
Range("DT").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'22 col: (main, 21 col back up), COPY: Paste-Values to right 1 col
Columns("EE:EY").Select
Selection.Copy
Range("EF1").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns("FE:FV").Select
Selection.Copy
Range("FG").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'double col: (1 set of 2), COPY: Paste-Values to different section
Columns("EC:ED").Select
Selection.Copy
Range("FE").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Target.Row < 130 Then Exit Sub
If Me.Cells(.Row, "A").Value = "." Then Exit Sub
'add "+" to blank spaces col A:
If Not Intersect(Me.Range("a:a"), .Cells) Is Nothing Then
Application.EnableEvents = False
.Value = Replace(.Value, " ", "+")
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CK:CO"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination:
With Me.Cells(.Row, "CF")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CW:CW"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination
With Me.Cells(.Row, "CG")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
End With
End Sub
 
N

Nastech

Nastech said:
hi, I get a compile error, unexpected end sub, at the first line.

created button (novice), from excel help entered vb as directed,
Click to expand...

THE Following line hilites yellow:

Private Sub CommandButton1_Click
 
N

Nastech

hi, thanks for the response, that seems to have helped:
error does not occur, but: No action on script takes place.

for the "lock" hi had been given, e.g.: "z" in particular cell
since error went to script before.. that link up is maybe working?

other settings, not sure what relevant, but calculate is set to off by
preference.
had script written for sheet ("ThisWorkbook" tab):

Option Explicit
Private Sub Workbook_Open()
Application.Calculate
'and just to make sure?????
'application.Calculation = xlCalculationManual
End Sub


Otherwise not sure what problem is;
code was placed above blank lines shown below by adding button procedure.
note code lower in other area (private sub worksheet)/ or similar needs to
be at top?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
N

Nastech

ouch, scratch last, used capital "Z", started but got error:
Run-time error '1004':
Method 'Range' of object '_Worksheet' failed

debug: yellow on:
Range("DT").Select
 
N

Nastech

Disregard, got it.. sorry ended up using as stepping board, but figured out
the fix was just the ranges.. my first major button.. what can i say..
thanks much both..

answer (all of script, above blank space items in question)


Option Explicit
Private Sub CommandButton1_Click()
If Range("DN6").Value = "Z" Then
'1 col: copy Paste-Values to left 1 col
Columns("DU:DU").Select
Selection.Copy
Range("DT:DT").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'22 col: (main, 21 col back up), COPY: Paste-Values to right 1 col
Columns("EE:EY").Select
Selection.Copy
Range("EF1").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns("FE:FV").Select
Selection.Copy
Range("FG:FX").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'double col: (1 set of 2), COPY: Paste-Values to different section
Columns("EC:ED").Select
Selection.Copy
Range("FE:FF").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Target.Row < 130 Then Exit Sub
If Me.Cells(.Row, "A").Value = "." Then Exit Sub
'add "+" to blank spaces col A:
If Not Intersect(Me.Range("a:a"), .Cells) Is Nothing Then
Application.EnableEvents = False
.Value = Replace(.Value, " ", "+")
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CK:CO"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination:
With Me.Cells(.Row, "CF")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CW:CW"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination
With Me.Cells(.Row, "CG")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
End With
End Sub
 
N

Nastech

hi, thankyou for your recent help, I was wondering if can get finish on 2
items working on?

the first is in trying to get INDIRECT reference, to cell / column
references below.
the last is to be able to clear out the guard cell, where "Z" is used to
allow the button to operate. thanks.

for ranges / cells described, would like to use an INDIRECT reference in
script, to cells that will not be moved (to reference cells that might be
moved)

the cells I am referencing using formula's that follow.
correlation is listed below, but imagine that I can insert where needed if I
can get the correct function.. thanks

cell B1 contains:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$DN$6),"$",""),"","")

cell B2 / C2 contains:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$DU2),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$DU2),"$",""),ROW(),"")

=SUBSTITUTE(SUBSTITUTE(CELL("address",$DT2),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$DT2),"$",""),ROW(),"")

which all output, in sheet, as follows (related to script using below)

DN6 in cell B1
DU:DU DT:DT B2 C2
EE:EY EF1 B3 C3
FE:FV FG:FX B4 C4
EC:ED FE:FF B5 C5

CK:CO CF B6 C6
CW:CW CG B7 C7


SCRIPT:

Option Explicit
Private Sub CommandButton1_Click()
If Range("DN6").Value = "Z" Then
'1 col: copy Paste-Values to left 1 col
Columns("DU:DU").Select
Selection.Copy
Range("DT:DT").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'22 col: (main, 21 col back up), COPY: Paste-Values to right 1 col
Columns("EE:EY").Select
Selection.Copy
Range("EF1").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns("FE:FV").Select
Selection.Copy
Range("FG:FX").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'double col: (1 set of 2), COPY: Paste-Values to different section
Columns("EC:ED").Select
Selection.Copy
Range("FE:FF").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Target.Row < 130 Then Exit Sub
If Me.Cells(.Row, "A").Value = "." Then Exit Sub
'add "+" to blank spaces col A:
If Not Intersect(Me.Range("a:a"), .Cells) Is Nothing Then
Application.EnableEvents = False
.Value = Replace(.Value, " ", "+")
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CK:CO"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination:
With Me.Cells(.Row, "CF")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
'make column changes:
If Not Intersect(Me.Range("CW:CW"), .Cells) Is Nothing Then
Application.EnableEvents = False
'Destination
With Me.Cells(.Row, "CG")
.NumberFormat = "dd"
.Value = Now
End With
Application.EnableEvents = True
End If
End With
End Sub
 
N

Nastech

hi, is there a way to modify the reference to columns,
to be from a different (single) cell, such as INDIRECT..
within a macro / script? Thanks


the type of lines I want to reference are:

Range("A1").Value
Columns("B:C").Select
Range("D:E").Select

Intersect(Me.Range("F:G"),
With Me.Cells(.Row, "H")
 

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

Similar Threads

DATE SCRIPT / add function col A, 2
Auto Date Script.. 1
too many dates macro 2
auto date script for 2 columns? have 1.. 2
Date Stamp with protection 6
macro: combine / modify date / hilite 1
Debug Issue 3
Macro range 4

Top