#1
|
|||
|
|||
auto fill numbers
Hi
I have 2 column (A,B..) whit a series of numbers ..which in other cases can vary both in rows and in columns can be generated reversed numbers based on the columns on the left with vba ? as in this example (blue cells) Thank you |
#2
|
||||
|
||||
Have a try with this macro:
Code:
Option Explicit Sub test() Dim i i = 2 Do Until Range("A" & i) = "" Range("A" & i).Offset(0, 3) = Range("A" & i) + 1 Range("B" & i).Offset(0, 1) = Range("B" & i) + 1 i = i + 1 Loop End Sub |
#3
|
|||
|
|||
thanks, works good but only for 2 column
can you make it work if there are more than 2 columns? the number of columns may vary... |
#4
|
||||
|
||||
Then try with this macro:
Code:
Option Explicit Sub test() Dim i As Long Dim x As Long Dim col As Long i = 2 col = Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'use if there is no data after the last used column in row 1 'col = Cells(1, 1).End(xlToRight).Column 'use if there are no empty columns before the last used in row 1 Do Until Cells(i, 1) = "" For x = 1 To col Cells(i, col * 2 - x + 1) = Cells(i, x) + 1 Next x i = i + 1 Loop End Sub |
#5
|
|||
|
|||
It's ok!
Thank you very much |
#6
|
||||
|
||||
Glad having been able to help .
Since you have only titles in row 1 then maybe change these lines of code to: Code:
col = Cells(i, Cells.Columns.Count).End(xlToLeft).Column 'col = Cells(i, 1).End(xlToRight).Column |
#7
|
|||
|
|||
one more thing, when empty cells are found, the script adds 1, can this cells remains empty?
|
#8
|
||||
|
||||
Change the line of code to:
Code:
If Cells(i, x) <> "" Then Cells(i, col * 2 - x + 1) = Cells(i, x) + 1 |
#9
|
|||
|
|||
Solved!
Good luck! |
#10
|
||||
|
||||
Your welcome.
|
#11
|
|||
|
|||
Hi again
I would like to modify your script below in such a way that the even numbers (blue cells) to be generated in the first empty row, as in the example below..can be done? Thank you Quote:
|
#12
|
||||
|
||||
This does the job:
Code:
Sub test() Dim x As Long Dim y As Long Dim cl As Long Dim rw As Long Dim cnt As Long cnt = 1 cl = Cells.Find("*", , , , xlByColumns, xlPrevious).Column rw = Cells.Find("*", , , , xlByRows, xlPrevious).Row For x = 1 To cl For y = 2 To rw If Cells(y, x) <> "" Then Cells(rw + cnt, cl - x + 1) = Cells(y, x) + 1 cnt = cnt + 1 Next y cnt = 1 Next x End Sub |
#13
|
|||
|
|||
Solved
Thanks for your help |
#14
|
||||
|
||||
You could get rid of one line of code by changing where to set the variable 'cnt', like this:
Code:
Sub test() Dim x As Long Dim y As Long Dim cl As Long Dim rw As Long Dim cnt As Long cl = Cells.Find("*", , , , xlByColumns, xlPrevious).Column rw = Cells.Find("*", , , , xlByRows, xlPrevious).Row For x = 1 To cl cnt = 1 For y = 2 To rw If Cells(y, x) <> "" Then Cells(rw + cnt, cl - x + 1) = Cells(y, x) + 1 cnt = cnt + 1 Next y Next x End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
auto fill up | mare1984 | Word | 1 | 06-27-2019 08:09 PM |
Auto Fill Forms | pgilbert0824 | Excel | 2 | 10-30-2016 01:02 AM |
Excel Auto-fill Issues | officeboy09 | Excel | 8 | 01-14-2014 05:52 PM |
auto fill a word doc from another program | hcubed | Office | 0 | 06-19-2013 09:42 PM |
Auto Color Fill Question | Kinar | Excel | 3 | 05-14-2013 07:46 AM |