Changing my offset formula

bartoni

Active Member
Joined
Jun 10, 2003
Messages
296
Hi,

Im adding data to sheets by copying and pasting data based on an offset function. If you see below im copying and pasting the code and then changing the column that the data taking from (in bold). Is there a quick way of coding the following rather then copying and pasting and just changing the number in bold.


Many Thanks

.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 4)
.End(xlToRight).NumberFormat = "0"
'Once next quarter of data added this
'becomes end of row, so offset by one cell
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 5)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 6)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 7)
.End(xlToRight).NumberFormat = "0"
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
One way would be to use Copy/Paste.

Another, something like this (without seeing the rest of your code it will need some changes):-
Code:
' PARTIAL CODE
Dim FromRange As Range
Dim ToRange As Range
Dim MyColumn As Integer
'------------------------
Set FromRange = _
    Sheets("data").Range(Cells(Range("rownum"), 4), Cells(Range("rownum"), 7))
'--------------------
With ActiveSheet
    MyColumn = .Range("IV1").End(xlToLeft).Column + 1
    Set ToRange = .Range(.Cells(1, MyColumn), .Cells(1, MyColumn + 3))
End With
'--------------------
With ToRange
    .Value = FromRange.Value
    .NumberFormat = "0"
End With
 

bartoni

Active Member
Joined
Jun 10, 2003
Messages
296
Thanks but i cant seem to get it to work. Ive declared the variables at the start of the macro. Where do i put the set "Fromrange part". I assume it can go anywhere as long as its before the "With activesheet" command.

Cheers
 

bartoni

Active Member
Joined
Jun 10, 2003
Messages
296
Heres the part of mu sub which contains the code and the looping part ive put in bold.
Many Thanks




Private Sub WorkDownColumn()

'These variables use currency because it has 4 decimal places
'Makes sure that macro begins with correct sheet
ActiveWorkbook.Sheets("original").Activate
' Select starting cell
Range("B2").Select
' Then locate next cell down
' After cell is selected, repeat function until end of column
' Macro ends when the next empty cell is reached
Do Until ActiveCell = ""
' Use the Excel worksheet function =match to locate the
' row of our product name
' and then compare the last two cells of this row
' with columns in the data sheet

Range("prdname").formula = ActiveCell
Range("rownum").FormulaR1C1 = "=match(prdname,products,0)"
If Cells(ActiveCell.Row, 33) = "" Then
If IsNumeric(Range("rownum")) Then


With Selection

.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 2)
.End(xlToRight).NumberFormat = "0"
'Once next quarter of data added this
'becomes end of row, so offset by one cell
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 3)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 4)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 5)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 6)
.End(xlToRight).NumberFormat = "0"
.End(xlToRight).Offset(0, 1) = _
Sheets("data").Cells(Range("rownum"), 7)
.End(xlToRight).NumberFormat = "0"


End With
Else
Cells(ActiveCell.Row, 36).formula = _
"Unmatched name"
End If
Else: ActiveCell.Offset(1, 0).Select
'offsets the activecell if column 33 is not blank i.e.
'the product already contains a full 30 quarters of data
End If

ActiveCell.Offset(1, 0).Select

Loop

Range("a1").Select

DeleteNotepad

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,119,002
Messages
5,575,488
Members
412,669
Latest member
nickyon1
Top