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"
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Yeah .... I'll just say the one word ... looping.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top