![]() |
Inserting a number of rows based on the number of columns filled bytext values
Hi
im trying to write a macro that will allow me to automat, inserting rows based on the number of columns filled by names, then transpose the names into the rows created. E.g. from this... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim to this.... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim any help would be kindly appreciated |
Inserting a number of rows based on the number of columns filled b
With your data starting from cell A1; try the below macro...with a sample..
Sub Macro() Dim lngRow As Long, lngCol As Long, lngLastRow As Long lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row + 2 lngRow = 1 Do While Trim(Cells(lngRow, 1)) < "" lngCol = 2 Cells(lngLastRow, 1) = Cells(lngRow, 1) Do While Trim(Cells(lngRow, lngCol)) < "" Cells(lngLastRow, 2) = Cells(lngRow, lngCol) lngCol = lngCol + 1 lngLastRow = lngLastRow + 1 Loop lngRow = lngRow + 1 Loop End Sub If this post helps click Yes --------------- Jacob Skaria "zorakramone" wrote: Hi im trying to write a macro that will allow me to automat, inserting rows based on the number of columns filled by names, then transpose the names into the rows created. E.g. from this... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim to this.... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim any help would be kindly appreciated |
Inserting a number of rows based on the number of columns filled by text values
On Thu, 30 Jul 2009 02:41:04 -0700 (PDT), zorakramone
wrote: Hi im trying to write a macro that will allow me to automat, inserting rows based on the number of columns filled by names, then transpose the names into the rows created. E.g. from this... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim to this.... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim any help would be kindly appreciated Try this macro: Sub zorakramone() first_row = 1 last_row = Cells(1, 1).End(xlDown).Row next_new_row = last_row + 1 For r = first_row To last_row first_column = 2 last_column = Cells(r, 255).End(xlToLeft).Column Rows(next_new_row).Insert shift:=xlDown Cells(next_new_row, 1) = Cells(r, 1) If last_column = 1 Then next_new_row = next_new_row + 1 For c = first_column To last_column If c 2 Then Rows(next_new_row).Insert shift:=xlDown Cells(next_new_row, 2) = Cells(r, c) next_new_row = next_new_row + 1 Next c Next r Rows(first_row & ":" & last_row).Delete shift:=xlUp End Sub You can comment out the last statement (Delete) until you have verified that the result is as expected. Hope this helps / Lars-Åke |
Inserting a number of rows based on the number of columns filledby text values
I assumed your data start at A1. try this one.
Sub movetest() Dim Stcell As Range, Encell As Range, Nxcell As Range Dim n As Long Application.ScreenUpdating = False Set Stcell = Cells(1, "A") Do While (Stcell < "") Set Encell = Cells(Stcell.Row, Cells.Columns.Count).End(xlToLeft) n = Range(Stcell, Encell).Cells.Count If n 2 Then Set Nxcell = Stcell.Offset(1, 0) Nxcell.Resize(n - 2).EntireRow.Insert Stcell.Offset(0, 2).Resize(, n - 2).Copy Stcell.Offset(1, 0).PasteSpecial Transpose:=True Stcell.Offset(0, 2).Resize(, n - 2).ClearContents Set Stcell = Nxcell Else Set Stcell = Stcell.Offset(1, 0) End If Loop On Error Resume Next For Each Stcell In Columns("A").SpecialCells(xlCellTypeBlanks) Stcell.EntireRow.Delete Next End Sub Keiji zorakramone wrote: Hi im trying to write a macro that will allow me to automat, inserting rows based on the number of columns filled by names, then transpose the names into the rows created. E.g. from this... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim to this.... Dave Peter Susan Luke Sam Bob Brad Pedro Joanna Pedro Danielle Jim any help would be kindly appreciated |
Inserting a number of rows based on the number of columns filledby text values
Hey Guys
thanks a lot for your all your help |
All times are GMT +1. The time now is 01:48 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com