View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.misc
nastech nastech is offline
external usenet poster
 
Posts: 383
Default Change Reference to Columns in a Macro

hi, scratch last note on error, had selected wrong cells in one of my fixed/
absolute cell locations. the script works great. thanks.

for others:
as using in/as reference cells:
(for dynamic reference for script to changing column/cell locations)

in cell: B1 gets: DN6
=SUBSTITUTE(SUBSTITUTE(CELL("address",$DN$6),"$"," "),"","")


in cell: B2 gets: DU:DU, etc. for other columns
=SUBSTITUTE(SUBSTITUTE(CELL("address",$DU2),"$","" ),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("addres s",$DU2),"$",""),ROW(),"")


script for moving data: (copy, paste-special-values);
other script for putting dates in columns when entering data, etc.


Option Explicit
Private Sub CommandButton1_Click()
Dim testCellAddress As String ' will hold "DN6" from B1
Dim singleColumnID As String ' will hold "DU:DU" from B2
Dim groupOneColumnID As String ' will hold "EE:EY" from B3
Dim groupTwoColumnID As String ' will hold "FE:FV" from B4
Dim groupThreeSourceID As String ' will hold "EC:ED" from B5
Dim groupThreeDestinationID As String ' will hold "FE:FF" from B6

'get the values from the active sheet. address must remain stable.
'can reference on another sheet in a similar fashion to:
'testCellAddress=Worksheets("AnotherSheetName").Ra nge("B1")

testCellAddress = Range("B1") ' .Value is implied
singleColumnID = Range("B2")
groupOneColumnID = Range("B3")
groupTwoColumnID = Range("B4")
groupThreeSourceID = Range("B5")
groupThreeDestinationID = Range("B6")

If Range(testCellAddress).Value = "Z" Then
'1 col: copy Paste-Values to left 1 col
Columns(singleColumnID).Select
Selection.Copy
Range(singleColumnID).Offset(0, -1).Select ' 1 column to the LEFT
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(groupOneColumnID).Select
Selection.Copy
Range(groupOneColumnID).Offset(0, 1).Select ' 1 column to the right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns(groupTwoColumnID).Select
Selection.Copy
Range(groupTwoColumnID).Offset(0, 2).Select ' 2 columns to the right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'double col: (1 set of 2), COPY: Paste-Values to different section
Columns(groupThreeSourceID).Select
Selection.Copy
Range(groupThreeDestinationID).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