auto fill numbers

Urraco · #1 05-11-2021, 04:56 AM

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

rollis13 · #2 05-12-2021, 10:17 AM

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

Urraco · #3 05-12-2021, 11:37 PM

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...

rollis13 · #4 05-13-2021, 02:39 AM

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

Urraco · #5 05-13-2021, 02:50 AM

It's ok!
Thank you very much

Quote:

Originally Posted by rollis13

Then try with this macro:

Code:

Option Explicit

rollis13 · #6 05-13-2021, 02:59 AM

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

Urraco · #7 05-13-2021, 03:14 AM

one more thing, when empty cells are found, the script adds 1, can this cells remains empty?

Quote:

Originally Posted by rollis13

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

rollis13 · #8 05-13-2021, 03:39 AM

Change the line of code to:

Code:

If Cells(i, x) <> "" Then Cells(i, col * 2 - x + 1) = Cells(i, x) + 1

Urraco · #9 05-13-2021, 04:37 AM

Solved!
Good luck!

Quote:

Originally Posted by rollis13

Change the line of code to:

Code:

If Cells(i, x) <> "" Then Cells(i, col * 2 - x + 1) = Cells(i, x) + 1

rollis13 · #10 05-13-2021, 05:29 AM

Your welcome.

Urraco · #11 06-17-2021, 02:31 AM

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:

Originally Posted by rollis13

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

rollis13 · #12 06-17-2021, 09:43 AM

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

Urraco · #13 06-18-2021, 05:52 AM

Quote:

Originally Posted by rollis13

This does the job:

Code:

Sub test()
    Dim x      As Long
    ...

Solved
Thanks for your help

rollis13 · #14 06-18-2021, 06:25 AM

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