New Line Data

C

Craddox

New Member
Joined
Feb 13, 2022
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi, I am struggling.... So what's new.

I have a worksheet in excel that has multiple rows and mutliple columns populated through VBA as text and numbers. Part of this is that from column S through to column XFD there could be a number that needs moving to the next line on the same worksheet. Once the number has been moved, the rest of the row (columns A through R) need to be copied to the same "new" row as the number. The code then needs to move onto the next column and do the same then once the row is completely checked it needs to move onto the next row and do the same again.

Some rows don't have any numbers in S:XFD and others could have numbers in every column.

Does anyone have any clues on how to do this and is this even possible?
 

Attachments

  • Example.jpg
    Example.jpg
    162.3 KB · Views: 9

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Unfortunately, my system security won't allow me to open the xl2bb file so I can't send this in this format.
 
Upvote 0
Craddox said:
my system security won't allow me to open the xl2bb
Click to expand...


Are you sure it isn't just the windows system putting it's normal block on files containing macro's that are downloaded

It is covered in the link in the instructions

1716201938816.png




or put the file in a Trusted location
 
Upvote 0
Example Sheet.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
1What I have
2ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
3134525324444535435124551
42135211412342112554
53411341552153243132441154123542
64333554145111445331
75423542515525435541
8
9What I want (after running code)
10ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
111345253244445354351
122135211412342112554
133411341552153243132
144333554145111445331
155423542515525435541
161345253244445354352
171345253244445354354
181345253244445354355
191345253244445354355
201345253244445354351
213411341552153243134
223411341552153243134
233411341552153243131
243411341552153243131
253411341552153243135
263411341552153243134
273411341552153243131
283411341552153243132
293411341552153243133
303411341552153243135
313411341552153243134
323411341552153243132
Sheet1
 
Upvote 0
As this is the first time using XL2BB to upload a mini sheet - does this work for you? Thanks
 
Upvote 0
The XL2BB is fine, the Mini sheet is the correct default option to use for posting.
I'll leave it for @Jeffrey Mahoney to look at as he requested it.
 
Upvote 0
Ok here's my first stab at it. I assumed headers to start on row one for each sheet. Also assumed you wanted the data copied to another sheet. Also assumed you didn't want to erase the data in the out range on sheet2. Assumed you didn't need coloring from the cells

BookAAA 20240520.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
1ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
2134525324444535435124551
32135211412342112554
43411341552153243132441154123542
54333554145111445331
65423542515525435541
Sheet1



BookAAA 20240520.xlsm
ABCDEFGHIJKLMNOPQRS
1ABCDEFGHIJKLMNOPQRS
21345253244445354351
31345253244445354352
41345253244445354354
51345253244445354355
61345253244445354355
71345253244445354351
82135211412342112554
93411341552153243132
103411341552153243134
113411341552153243134
123411341552153243131
133411341552153243131
143411341552153243135
153411341552153243134
163411341552153243131
173411341552153243132
183411341552153243133
193411341552153243135
203411341552153243134
213411341552153243132
224333554145111445331
235423542515525435541
Sheet2



VBA Code: 
Sub CreateNewLines()
  Dim Cel As Range
  Dim CC As Range
  Dim Rng As Range
  Dim aSht As Worksheet
  Dim NewSht As Worksheet
  Dim ColTAJ As Range
  Dim ColAS As Range
  Dim OutS As Range
  Dim OutCel As Range
  Dim OutRng As Range
  
  
  Set aSht = ActiveSheet
  Set ColAS = aSht.Range("A:S")
  Set ColTAJ = aSht.Range("T:AJ")
  Set NewSht = Sheets("Sheet2")   'Copy the data to this sheet
  Set OutS = NewSht.Range("S1")   'Top of table where data needs to be copied
  
  Set Cel = Range("A2")           'Starting row of data to be copied
  With aSht
    Set Rng = Range(Cel, .Cells(.Cells.Rows.Count, 1).End(xlUp))  'Values in column A
  End With
  
  For Each Cel In Rng
    Set OutCel = NewSht.Cells(NewSht.Rows.Count, OutS.Column).End(xlUp).Offset(1, 0)  'Next blank row
    Set OutRng = Intersect(NewSht.Range("A:S"), OutCel.EntireRow)                     'Columns A - S
    OutRng.Value = Intersect(Cel.EntireRow, ColAS).Value
    For Each CC In Intersect(ColTAJ, Cel.EntireRow)
      If CC.Value <> "" Then
        Set OutCel = NewSht.Cells(NewSht.Rows.Count, OutS.Column).End(xlUp).Offset(1, 0)  'Next blank row
        Set OutRng = Intersect(NewSht.Range("A:S"), OutCel.EntireRow)                     'Columns A - S
        OutRng.Value = Intersect(Cel.EntireRow, ColAS).Value
        OutCel.Value = CC.Value                                                           'Copy new value
      End If
    Next CC
  Next Cel
  
End Sub
 
Upvote 0
Hi Jeffrey,

Thank you for the code although i am a little lost with some of it. I've had to adapt it a little as the ranges in the "actual" sheet is different to those in the mock up. When I've run the code there appear to be 2 issues:

1. It takes forever to run and keeps flashing up that it's calculating the threads.
2. It only appears to copy the header row and doesn't copy anything else.

This could be purely due to the adaptations I made but I can't see where I've gone wrong.

Any help would be appreciated.

Thanks

The adapted code is shown below:

Sub CreateNewLines()
'
Dim Cel As Range
Dim CC As Range
Dim Rng As Range
Dim aSht As Worksheet
Dim NewSht As Worksheet
Dim ColTAJ As Range
Dim ColAS As Range
Dim OutS As Range
Dim OutCel As Range
Dim OutRng As Range

Set aSht = ActiveSheet
Set ColAS = aSht.Range("B:R")
Set ColTAJ = aSht.Range("S:AJ")
Set NewSht = Sheets("Income") 'Copy the data to this sheet
Set OutS = NewSht.Range("B2") 'Top of table where data needs to be copied

Set Cel = Range("A2") 'Starting row of data to be copied
With aSht
Set Rng = Range(Cel, .Cells(.Cells.Rows.Count, 1).End(xlUp)) 'Values in column A
End With

For Each Cel In Rng
Set OutCel = NewSht.Cells(NewSht.Rows.Count, OutS.Column).End(xlUp).Offset(1, 0) 'Next blank row
Set OutRng = Intersect(NewSht.Range("B:R"), OutCel.EntireRow) 'Columns B - R
OutRng.Value = Intersect(Cel.EntireRow, ColAS).Value
For Each CC In Intersect(ColTAJ, Cel.EntireRow)
If CC.Value <> "" Then
Set OutCel = NewSht.Cells(NewSht.Rows.Count, OutS.Column).End(xlUp).Offset(1, 0) 'Next blank row
Set OutRng = Intersect(NewSht.Range("B:R"), OutCel.EntireRow) 'Columns B - R
OutRng.Value = Intersect(Cel.EntireRow, ColAS).Value
OutCel.Value = CC.Value 'Copy new value
End If
Next CC
Next Cel
'
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
T
  • Solved
Large Sheet-Need to Get blank cells to equal proceeding cell when blank
Replies
2
Views
70
TWTHOMAS
T
W
  • Solved
VBA - Match two values from Table1 to two in Table2 and move/align
2
Replies
15
Views
376
Welshy1491
W
C
  • Solved
Macro/VBA for lookups
Replies
9
Views
183
mumps
mumps
B
  • Solved
VBA for Generating Cycle Counts
2
Replies
17
Views
718
kvsrinivasamurthy
K

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top