Solved: Loop problem: Trying to write data to 5 cols

[Glaswegian]

Hi

I'm trying to take a set of numbers, lower value and upper value taken from an input box, and write them to columns A to E.

For example, the range of numbers is 1 - 15, then the final result should be

A B C D E

1 2 3 4 5
6 7 8 9 10
11 12 13 14 15

Needless to say my feeble attempts at this are not working out. This is what I have so far

Sub numberdata()
Dim Num1 As Integer
Dim Num2 As Integer
Dim x As Integer
Dim z As Integer

Num1 = Application.InputBox("Enter the first number", "Start Number", Type:=1)
If Num1 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If
Num2 = Application.InputBox("Enter the second number", "End Number", Type:=1)
If Num2 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

For x = 1 To 5
For z = Num1 To Num2
ActiveSheet.Cells(Num1, x).Value = z
Next z
Next x

End Sub Would it be better to load the data into an array? (not something I was ever good at...)

Thanks for any help.

[Bob Phillips]

Sub numberdata()
Dim Num1 As Integer
Dim Num2 As Integer
Dim x As Integer
Dim z As Integer

Num1 = Application.InputBox("Enter the first number", "Start Number", Type:=1)
If Num1 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

Num2 = Application.InputBox("Enter the second number", "End Number", Type:=1)
If Num2 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

For x = 1 To (Num2 - Num1 + 5) \ 5
For z = 1 To 5
With ActiveSheet.Cells(x, z)
If (x - 1) * 5 + z <= Num2 - Num1 + 1 Then
.Value = Num1 + (x - 1) * 5 + (z - 1)
Else
.Value = ""
End If
End With
Next z
Next x

End Sub

[p45cal]

I'm not 100% sure on this, but I think that last bit of code:
For x = 1 To (Num2 - Num1 + 5) \ 5
For z = 1 To 5
With ActiveSheet.Cells(x, z)
If (x - 1) * 5 + z <= Num2 - Num1 + 1 Then
.Value = Num1 + (x - 1) * 5 + (z - 1)
Else
.Value = ""
End If
End With
Next z
Next x can be shortened toi = 0
For x = Num1 To Num2
i = i + 1
Range("A1:E1").Cells(i) = x
Next xIt at least seems to give the same result.

[rbrhodes]

Hi Glaswegian,

A couple of notes.

1) Not a 'feeb'e' attempt at all, just new to loops? I'd guess.

2) Your code will bail if the first or second number is 0 as 0 = False. Don't know if you would always be entering a series of numbers above (and not including 0).

3) It will also fail if the OK button is clicked on the input box as that is not type:= 1 and there is no errorhandling for that move.

So, although your actual question has been answered, I offer this bit. It:

- accounts for integers (as defined by Excel) if the 2nd number is greater than the 1st, ie it allows for 0 as a number. Bonus: it also allows negatives!

- clears old data from Cols A to E

- turns off screen updating for speed

- takes you back to re-enter your numbers if Num1 is less than Num2. This could be changed to allow negative progressions if you wish...

- exits if the series is less than Series/5

- other stuff.


Let me know if it's worth looking at and all.


Option Explicit
Sub numberdata()
Dim x As Integer
Dim z As Integer
Dim Num1 As Variant
Dim Num2 As Variant
Dim eMsg As Integer
Dim myRow As Integer
'//CHANGE TO SUIT
'set first destination row
myRow = 1
'oops label
LessThan:
'//get First number and check
Num1 = Application.InputBox("Enter the first number", "Start Number")
If Num1 = "False" Or Num1 = "" Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If
'//get Second number and check
Num2 = Application.InputBox("Enter the second number", "End Number")
If Num2 = "False" Or Num2 = "" Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

'check difference for 'positive' result. ie: second number
' greater than first number even if negative or zero
If Num2 < Num1 Then
eMsg = MsgBox("Second number (" & Num2 & ") must be greater than first number (" & Num1 & "). Please try again!", vbCritical, "No Negatives!")
GoTo LessThan
End If

'clear old data in Col A to E
Range(Cells(myRow, 5), Cells(65536, 1).End(xlUp)).Clear

'speed
Application.ScreenUpdating = False

'do until done
Do
'put Cols A to E if exist
For x = 1 To 5
ActiveSheet.Cells(myRow, x).Value = Num1
'increment Num1 for check
Num1 = Num1 + 1
'check if we're done, exit if yes
If Num1 = Num2 + 1 Then GoTo endo
'nope, put next number of series
Next x
'increment destination row if 5 cols done
myRow = myRow + 1
'keep going...
Loop

endo:
'reset
Application.ScreenUpdating = True

End Sub

[Glaswegian]

Thanks all for your replies.

I'm not that new to loops - just rusty. Various job changes over the last few years mean that I don't do as much Excel and VBA as I used to.

All your examples work really well - I'm very grateful.

The boss that wants this has asked if it would be possible to 'skip' a row. What he means is, if the range of numbers is 1 - 20, can we write the values like this?

1 2 3 4 5
11 12 13 14 15
16 17 18 19 20

or is there any easy way to allow a choice of which lines to skip?

[Bob Phillips]

Sub numberdata()
Dim Num1 As Integer
Dim Num2 As Integer
Dim RowMiss As Long
Dim x As Long, y As Long, z As Long

Num1 = Application.InputBox("Enter the first number", "Start Number", Type:=1)
If Num1 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

Num2 = Application.InputBox("Enter the second number", "End Number", Type:=1)
If Num2 = False Then
MsgBox "Operation cancelled", vbInformation + vbOKOnly, "Warning"
Exit Sub
End If

RowMiss = Application.InputBox("Entyer row to skip, or Cancel to include all", "Skip row", Type:=1)

y = 0
For x = 1 To (Num2 - Num1 + 5) \ 5
If Not IsNumeric(RowMiss) Or RowMiss <> x Then
y = y + 1
For z = 1 To 5
With ActiveSheet.Cells(y, z)
If (x - 1) * 5 + z <= Num2 - Num1 + 1 Then
.Value = Num1 + (x - 1) * 5 + (z - 1)
Else
.Value = ""
End If
End With
Next z
End If
Next x

End Sub

[rbrhodes]

Hi,

I note there is a plural here (lines)

"or is there any easy way to allow a choice of which lines to skip?"

Also are you looking to skip a row_number, a certain number or a range of 5 numbers?

[Glaswegian]

Hi again

rbrhodes you are correct - I meant being able to skip 5 numbers each time. So if you wanted numbers between 1 and 101, you would then get

1 6 11 16 21
26 31 36 41 46

does that make sense?

xld - many thanks - could your code be amended to skip every fifth number?

[mdmackillop]

Option Explicit
Sub EnterNos()
Dim data As String
Dim Strt As Long, Endd As Long, Intl As Long
Dim i As Long, j As Long
data = InputBox("Enter Start, End and Interval" & vbCr & _
"eg 1,1000,5")

Strt = Split(data, ",")(0)
Endd = Split(data, ",")(1)
Intl = Split(data, ",")(2)

For i = 1 To Int(Endd / 5 / Intl) + 1
For j = 1 To 5

Cells(i, j) = Strt
Strt = Strt + Intl
If Strt > Endd Then Exit Sub
Next
Next
End Sub

[Bob Phillips]

How about a UDF where you select the start value and (optional) skip value



Function MySeries(startVal, Optional skip)
Dim cell As Range
Dim i As Long, j As Long
Dim nRows As Long, nCols As Long
Dim nVal As Double
Dim tmp
If IsMissing(skip) Then skip = 1
nRows = Selection.Rows.Count
nCols = Selection.Columns.Count
ReDim tmp(1 To nRows, 1 To nCols)
nVal = startVal
For i = 1 To nRows
For j = 1 To nCols
tmp(i, j) = nVal
nVal = nVal + skip
Next j
Next i
MySeries = tmp

End Function


Select the worksheet cells that you want to populate, and call the UDF like

=MySeries(1,5)

as a block-array function.

[Norie]

Iain

I think you really need to clarify what exactly it is you (or your boss) wants?

[rbrhodes]

Right you are Norie!

The first example was to SKIP by 5, part of the series:

1 2 3 4 5
<skip>
6 7 8 9 10
11 12 13 14 15

The 2nd example is to STEP by 5, a different series:

1 6 11 16 21
26 31 36 41 46

Seems Glaswegians do have their own logic as well as language! <G>

...ducking while running....

[Glaswegian]

Iain

I think you really need to clarify what exactly it is you (or your boss) wants?

Hi Norie - lol - wish I had the answer to that (and many other) question!

Malcolm - quite superb - I reckon that will do the job - many thanks indeed.

Apologies for any confusion and thanks to all for the assistance.

[Norie]

Iain

So is it solved?

Perhaps it was me having the problem understanding, it was Saturday night after all. :winking2: