Offset rather than select/activate

[Jaye7]

Norie advised not to select or activate cells but I don't know how to offset from the activecell as in my following code.

The script looks for values in column D, if it finds the value it offsets the value from column A to another cell.

Sub Process1()
 
Application.Calculation = xlCalculationManual
Range("D2").Select
ActiveCell.Offset(0, -1).Select
Cells(65535, ActiveCell.Column).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveCell.Select
   ActiveCell.Offset(0, 1).Select
Set BottomCell = ActiveCell
    Set TOPCELL = Cells(2, ActiveCell.Column)
      Range(TOPCELL, BottomCell).Select
 
 Dim Cell As Range
For Each Cell In Selection.Cells
If Cell.HasFormula = False Then
End If
 
 
If ActiveCell.Value = 2 Then
ActiveCell.Offset(-1, 1).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 3 Then
ActiveCell.Offset(-2, 2).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 4 Then
ActiveCell.Offset(-3, 3).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 5 Then
ActiveCell.Offset(-4, 4).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 6 Then
ActiveCell.Offset(-5, 5).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 7 Then
ActiveCell.Offset(-6, 6).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 8 Then
ActiveCell.Offset(-7, 7).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 9 Then
ActiveCell.Offset(-8, 8).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 10 Then
ActiveCell.Offset(-9, 9).Value = ActiveCell.Offset(0, -3).Value
End If
If ActiveCell.Value = 11 Then
ActiveCell.Offset(-10, 10).Value = ActiveCell.Offset(0, -3).Value
End If
 
ActiveCell.Offset(1, 0).Select
Next
Application.Calculation = xlCalculationAutomatic
 
End Sub

 

[Norie]

You should probably not use ActiveCell here.

In fact looking at the code I'm finding it hard to follow what the active cell is.

I think I know what you are trying to do though.

You are trying to check every cell with data in a column (might be columns).

Which column is that?

Is it C or D?

Whichever, here's how you could try things.

I'll use column C but that can be changed.

Dim rng As Range
Dim cell As Range 
Dim LastRow As Long
     
     ' find last row in column C
     LastRow = Range("C" & Rows.Count).End(xlUp).Row
     
     Set rng =Range("C2:C" & LastRow)

     ' loop through cells
     For Each cell in rng.Cells

          If cell.Value = 2 Then
               cell.Offset(-1, 1).Value = cell.Offset(0, -3).Value
          End If

          If cell.Value = 3 Then
               cell.Offset(-2, 2).Value = cell.Offset(0, -3).Value
          End If

          '...
          ' rest of If statements
          '...

          If cell.Value = 11 Then
               cell.Offset(-10, 10).Value = cell.Offset(0, -3).Value
          End If

     Next cell

Hope that makes some sense.

 

[alvinwlh]

Hi,

May be you can explain on how you want the script to work?

As of what I know (Correct me if i am wrong):

1) Select the Cells from D2 to End of column D
2) Get the value in each of the above cell as reference let say x.
3) Get the value in A and
4) ???? Paste it to the value which has a offset of (-x,x)??
(-x,x) could be wrong cause it offset up x row and right x column.

 

[Jaye7]

Norie,

D2 has the values 1 - 11 etc...

I adapted your code to reflect D, C in my script was setting the range but could have been D, I copied the script from another script I had which had no values in D and then set the range D based on C.

Sub test2()
Dim rng As Range
Dim cell As Range
Dim LastRow As Long
 
     ' find last row in column C
     LastRow = Range("D" & Rows.Count).End(xlUp).Row
 
     Set rng = Range("D2:D" & LastRow)
     ' loop through cells
     For Each cell In rng.Cells
          If cell.Value = 2 Then
               cell.Offset(-1, 1).Value = cell.Offset(0, -3).Value
          End If
          If cell.Value = 3 Then
               cell.Offset(-2, 2).Value = cell.Offset(0, -3).Value
          End If
          '...
          ' rest of If statements
          '...
          If cell.Value = 11 Then
               cell.Offset(-10, 10).Value = cell.Offset(0, -3).Value
          End If
     Next cell
End Sub

Is there a way to loop the if statements so that it counts the values in D and loops.

Anthony provided a loop for a different script which finds values in columns C to I and puts them in A and I thought this could happen for this script also.

Anthony's code was.

Sub reall()
For J = 3 To 9 'Columns C to I
For I = 2 To Cells(Rows.Count, J).End(xlUp).Row
If Cells(I, J) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, J)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
Next J
End Sub

 

[Norie]

What is it you want counts of?

The no of 1s in column D, the no of 2s in column D and so on?

 

[alvinwlh]

          For Each cell In rng.Cells
               cell.Offset((cell.Value-1)*-1, (cell.Value-1)).Value = cell.Offset(0, -3).Value
          Next

 

[Jaye7]

Hi Alvin,

The script works great except where it finds a 1 it is replacing the value in column D, my original code started at number 2 as number 1 was the original value and therefore didin't need to offset.

If I don't have a value of 1 in the column then it won't work it bugs out.

 

[alvinwlh]

Try

          For Each Cell In Rng.Cells
            If Cell.Value > 1 Then
                Cell.Offset((Cell.Value - 1) * -1, (Cell.Value - 1)).Value = Cell.Offset(0, -3).Value
            End If
          Next

 

[Jaye7]

Alvin,

As long as I have a value of 1 in column D it is working, if the value starts at 2 it will not work.

That's find though I can work around that by making sure the 1st value is 1.

My test data was the following, each column is represented by the space between values

col A col B col C col D

a 2 1 1
a 3 2 2
a 4 3 3
a 5 4 4
a 6 5 5
a 7 6 6
a 8 7 7
cc 2 1 1
cc 3 2 2
cc 4 3 3
cc 5 4 4
cc 6 5 5
cc 7 6 6
cc 8 7 7
dd 2 1 1
dd 3 2 2
dd 4 3 3


it ends up as the following, which is what I am after.
It is basically an offset function for duplicated data, which I use in excel 2000 version

a 2 1 1 a a a a a a
a 3 2 2
a 4 3 3
a 5 4 4
a 6 5 5
a 7 6 6
a 8 7 7
cc 2 1 1 cc cc cc cc cc cc
cc 3 2 2
cc 4 3 3
cc 5 4 4
cc 6 5 5
cc 7 6 6
cc 8 7 7
dd 2 1 1 dd dd
dd 3 2 2
dd 4 3 3

 

[alvinwlh]

Hi, Bro

Try this:
1) It start from Row 2:
2) It uses Column A to index only.

Sub test2()
Dim Valuee, Now_valuee As String
Dim x, record_row, i As Integer
Dim LastRow As Long
 
     x = 2
     Now_valuee = ""
     Do
        Valuee = Range("A" & x).Value
        If Now_valuee <> Valuee Then
            Now_valuee = Valuee
            record_row = x
            i = 0
        Else
            Range("A" & record_row).Offset(0, 4 + i).Value = Valuee
            i = i + 1
        End If
        x = x + 1
     Loop While Range("A" & x).Value <> ""
 
End Sub