Sub FillNumbers()
Dim rng As Range
On Error Resume Next
For Each rng In Selection.SpecialCells(xlCellTypeBlanks).Areas
rng.Formula = "=ROWS(A$1:A1)-1"
rng.Value = rng.Value
Next rng
End Sub
Sub FillNumbersInSelectedRange()
Dim rng As Range
On Error Resume Next
For Each rng In Selection.SpecialCells(xlCellTypeBlanks).Areas
rng.Formula = "=ROWS(A$1:A1)-1"
rng.Value = rng.Value
Next rng
End Sub
Sub FillNumbersWithoutSelectingRange()
Dim lr As Long
Dim rng As Range
lr = Cells(Rows.Count, "N").End(xlUp).Row
Set rng = Range("N2:N" & lr)
On Error Resume Next
For Each rng In rng.SpecialCells(xlCellTypeBlanks).Areas
rng.Formula = "=ROWS(A$1:A1)-1"
rng.Value = rng.Value
Next rng
End Sub
Fill-Numbers.xlsm
Sub testmethod()
Dim count1 As Long
Dim count2 As Long
Dim count3 As Long
Dim count4 As Long
Dim count5 As Long
Dim count6 As Long
Dim myValue As Long
count1 = 2
count2 = 14
count3 = 2
count4 = 1
count5 = 2
count6 = 2
rawData.Activate ' activating the relevant worksheet
Range("A2").Select ' selecting the reference point
If ActiveCell.Value = "106" Then ' these are codes, different number refers to different person
Do
myValue = ActiveCell.Offset(0, 13).Value ' assign the value 13 cells to the right of the active cell to a long variable
myData.Activate ' the next sheet where I want to paste the data
Cells(count5, count6).Value = myValue ' pasting the data in the relevant cell
count6 = count6 + 1 'moving one column to the right on the same row
rawData.Activate 'back to the worksheet to copy the data
ActiveCell.Offset(1, 0).Select ' move one row down
Loop While ActiveCell.Value = "106" 'loop while that condition holds
ElseIf ActiveCell.Value = "108" Then
count5 = count5 + 1 ' moves the counter so that in the copying to sheet i start copying one row down for the next participant.
Do
myValue = ActiveCell.Offset(0, 13).Value
myData.Activate
Cells(count5, count6).Value = myValue
count6 = count6 + 1
rawData.Activate
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.Value = "108"
End If
End Sub
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
12 Experts available now in Live!