Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-11-2021, 04:56 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default 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
Attached Images
File Type: jpg [1]05-11-2021.jpg (17.8 KB, 31 views)
Attached Files
File Type: xlsx Book1.xlsx (9.0 KB, 5 views)
Reply With Quote
  #2  
Old 05-12-2021, 10:17 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

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
Reply With Quote
  #3  
Old 05-12-2021, 11:37 PM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

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...
Reply With Quote
  #4  
Old 05-13-2021, 02:39 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

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
Reply With Quote
  #5  
Old 05-13-2021, 02:50 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

It's ok!
Thank you very much

Quote:
Originally Posted by rollis13 View Post
Then try with this macro:
Code:
Option Explicit
Reply With Quote
  #6  
Old 05-13-2021, 02:59 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

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
Reply With Quote
  #7  
Old 05-13-2021, 03:14 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

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

Quote:
Originally Posted by rollis13 View Post
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
Attached Images
File Type: jpg [1]05-13-2021.jpg (60.6 KB, 24 views)
Reply With Quote
  #8  
Old 05-13-2021, 03:39 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

Change the line of code to:
Code:
If Cells(i, x) <> "" Then Cells(i, col * 2 - x + 1) = Cells(i, x) + 1
Reply With Quote
  #9  
Old 05-13-2021, 04:37 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

Solved!
Good luck!

Quote:
Originally Posted by rollis13 View Post
Change the line of code to:
Code:
If Cells(i, x) <> "" Then Cells(i, col * 2 - x + 1) = Cells(i, x) + 1
Reply With Quote
  #10  
Old 05-13-2021, 05:29 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

Your welcome.
Reply With Quote
  #11  
Old 06-17-2021, 02:31 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

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 View Post
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
Attached Images
File Type: jpg [1]06-17-2021.jpg (17.3 KB, 12 views)
Attached Files
File Type: xlsx Book2.xlsx (8.7 KB, 4 views)
Reply With Quote
  #12  
Old 06-17-2021, 09:43 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

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
Reply With Quote
  #13  
Old 06-18-2021, 05:52 AM
Urraco Urraco is offline auto fill numbers Windows 8 auto fill numbers Office 2016
Advanced Beginner
auto fill numbers
 
Join Date: Apr 2018
Posts: 30
Urraco is on a distinguished road
Default

Quote:
Originally Posted by rollis13 View Post
This does the job:
Code:
Sub test()
    Dim x      As Long
    ...
Solved
Thanks for your help
Reply With Quote
  #14  
Old 06-18-2021, 06:25 AM
rollis13's Avatar
rollis13 rollis13 is offline auto fill numbers Windows 10 auto fill numbers Office 2016
Advanced Beginner
 
Join Date: Jan 2021
Location: Cordenons
Posts: 57
rollis13 is on a distinguished road
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
auto fill up mare1984 Word 1 06-27-2019 08:09 PM
auto fill numbers Auto Fill Forms pgilbert0824 Excel 2 10-30-2016 01:02 AM
auto fill numbers 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 fill numbers Auto Color Fill Question Kinar Excel 3 05-14-2013 07:46 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:12 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2021, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2021 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft