Hello,
I have an example below, I'd like to take the first row, copy it "n" number of times, then take the next row copy it the same "n" number of times, till the end of the rows.
It is a bother to modify a already created macro even it it is one's own.
I have given you another macro similar to one given before.
Sub test()
Dim rng As Range, c As Range
Dim rng1 As Range, c1 As Range
Dim dest As Range, j As Integer, k As Integer
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("A2").End(xlDown))
j = WorksheetFunction.CountA(.Rows("1:1"))
'msgbox j
For Each c In rng
Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft))
'msgbox rng1.Address
For Each c1 In rng1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'msgbox dest.Address
If c1 = "" Then GoTo line1
'dest.Offset(0, 0) = c
'dest.Offset(0, 1) = .Cells(1, c1.Column)
'dest.Offset(0, 2) = c1
dest = c
dest.Offset(0, 1) = c1
dest.Offset(0, 2) = .Cells(1, c1.Column)
line1:
Next c1
Next c
End With
With Worksheets("sheet2").Columns("c:c")
.NumberFormat = "dd-mmm-yy"
End With
End Sub
Sub test()
Dim n As Integer, rng As Range
'n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
n = InputBox("type no. of times you want to be repeated minus 1 for e.g if you wnat to be repeated 3 times type 2")
Range(rng.Offset(1, 0), rng.Offset(n, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"
End Sub
Hi Venkat..I understand that you asked to create a new thread but since my query is based on solution prvided in one of the above , I preferred to keep it in same thread.
This macro worked fpr a part of my need but I have 2 more things to handle in my Macro.
1st) rather than taking Input from User I have to take it from a cell in same row
2nd ) When coppying cells after taking value from last last copy for each row should be Bold.
I am using your code but it only copies the first row but the next one. I need to copy each row down for 15 times and I have 900 rows in total. Could you please help me.
Thanks
I have added two more rows to check my macro. This is in SHEET1 as follows
Start Date End Date Start Time End Time Group Sub Group Details Manager
9/23/2009 9/25/2009 10:00 AM 11:00 AM Class X section 1 Goes for preparation Teacher 1
9/27/2009 9/29/2009 10:00 AM 11:00 AM class xi section 1 xxxxxxx teacher 2
10/2/09 10/6/2009 10:00 AM 11:00 AM class xi section 1 xxxxxxx teacher 2
carefully type this in sheet1
copy this data in sheet 2also from A1 to retrieve for rechecking
KEEP SHEET1 AS ACTIVE SHEET now run this macro "test" and see whether you get what you want in sheet1.
if you want to recheck.
1. run the macro "undo"
and then
2. run the macro "test"(ALWAYS KEEPING SHEET 1 AS ACTIVE SHEET)
Sub test()
Dim j As Integer, k As Integer, m As Integer, n As Integer
j = Range("a1").End(xlDown).Row
'j is hte lsst row
k = j
Do
If k = 1 Then Exit Do
m = Cells(k, "b") - Cells(k, "A")
'MsgBox m
'Range(Cells(k + 1, "A"), Cells(k + m, "A")).Select
Range(Cells(k + 1, "A"), Cells(k + m, "A")).EntireRow.Insert
For n = 1 To m
Cells(k, 1).EntireRow.Copy Cells(k + n, 1)
Next n
For n = 1 To m
Cells(k + n, 1) = Cells(k, 1) + n
Next n
k = k - 1
'MsgBox k
Loop
End Sub
Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").UsedRange.Copy Worksheets("sheet1").Range("A1")
Could you please help me with the following macro.
The following macro basically copies the entire row if the column B contains the value "1". But in my case, I would like to copy the entire row if a range of column (for ex: B via Z) contains the value "1". It would even be better, if the user could input a number/string and then if the column range from B via Z contains that specific string/number - it will automatically copy the entire row that contains that value in a new worksheet/xls file.
Hope to hear from you.
Thanks!
N.
Sub SearchForNumber1()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 1
LSearchRow = 1
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("B" & CStr(LSearchRow)).Value = "1" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Nora
quote
Could you please help me with the following macro.
The following macro basically copies the entire row if the column B contains the value "1". But in my case, I would like to copy the entire row if a range of column (for ex: B via Z) contains the value "1". It would even be better, if the user could input a number/string and then if the column range from B via Z contains that specific string/number - it will automatically copy the entire row that contains that value in a new worksheet/xls file.
unquote
try this macro (here an input box will come up and you have to string or number to be searched)
one condition-there should not be a gap in the data
Sub test()
Dim rr As Range, cr As Range, rc As Range, cc As Range, x
x = InputBox("type the relevant no. or string e.g. 45")
With Worksheets("sheet2")
.Cells.Clear
End With
With Worksheets("sheet1")
Set rr = Range(.Range("a2"), .Range("a2").End(xlDown))
For Each cr In rr
Set rc = Range(.Cells(cr.Row, 1), .Cells(cr.Row, 1).End(xlToRight))
Set cc = rc.Cells.Find(what:=x, lookat:=xlWhole)
If Not cc Is Nothing Then
cc.EntireRow.Copy
Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next cr
End With
Application.CutCopyMode = False
End Sub
I was wondering if you could help me as well as it appears you have greatly assisted the previous individual. I am trying to copy an entire row from worksheet named "Gallagher" to another worksheet named "CURRENT" if column D (from Gallagher) contains the text "No". I have multiple worksheets within the workbook that I would like to link to the "CURRENT" worksheet if the column D contains the next "No" so ultimately would like the code to be able to recognize the last unused row/cell in "CURRENT" so when it pastes rows from the other worksheets, it will know where to begin pasting.
Need help please. I am converting a Accounts receivable customers date file to our data format for our AR system. They have many columns of data from column A-P. Their customers account number is in column D. Here is the problem. They have multiple lines for each account number. They only write the address for the 1st account number. If the next line is the same account number then they don't move the customers name address into the fields they leave it blank until the account number is different. Our system requires the data to be in all fields. So if the account number in column D is 76883 and the next line contains the same account number 76883 then all the name and address fields are blank. So if the account number is the same then I need to copy the customer name (column F), customer addr1 (column G), addr2 (column H), addr3 (column I) into the next line for the entire data file. Here is the if statement defination. IF DI = DI+1 then copy FI to FI +1, GI to GI+1, HI TO HI +1. My problem is I don't know how to make it generic to copy each line and figure out a macro. Please help!
Sub test()
Dim rng As Range, c As Range
Dim rng1 As Range, c1 As Range
Dim dest As Range, j As Integer, k As Integer
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("A2").End(xlDown))
j = WorksheetFunction.CountA(.Rows("1:1"))
'msgbox j
For Each c In rng
Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft))
'msgbox rng1.Address
For Each c1 In rng1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'msgbox dest.Address
If c1 = "" Then GoTo line1
dest.Offset(0, 0) = c
dest.Offset(0, 1) = .Cells(1, c1.Column)
'dest.Offset(0, 2) = c1
line1:
Next c1
Next c
End With
End Sub
another method -pivot table of database.-
ref: wlakenbach blog
http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/
Aces... with minor tweaking for my 'real' document, it WORKS great, and I understand 50% of how it works :)
There is one last ‘need’ for my Enterprise upload... the DATE found in and across “Row 1, ‘$A$2:$A*’”
I need the macro to take the Rawdata, which is the forecast in cross tabular form (see below)
Rawdata:
ColA ColB ColC ColD
Item 6/1/2009 7/1/2009 8/1/2009
Part 1 50 55 6
Part 2 1 5 10
and produce the following results:
sheet2:
ColA ColB ColC
Part 1 39965 6/1/2009
Part 1 39995 7/1/2009
Part 1 40026 8/1/2009
Part 2 39965 6/1/2009
Part 2 39995 7/1/2009
Part 2 40026 8/1/2009
With what you provided me (THANK YOU SO MUCH) I am able to create ColA & ColB.
If I need to, I am able to copy & paste special ("transpose") the date range from the Rawdata. Unfortunately, when I have hundreds of parts it is just a little time consuming… so if the action can be incorporated into the macro, it would make my job go even faster.
Thank you again. Just so you don't think I am a leach wasting your talent, I have already signed up for Tutorial Excel & Access lessons with our Microsoft IS/IT package. Being able to do what you created will definitely make me more valuable.
I apologize, I miss typed in my sample/request above....
I need the additional macro lines to take the Rawdata, which is the forecast in cross tabular form (see below)
Rawdata:
ColA ColB ColC ColD
Item 6/1/2009 7/1/2009 8/1/2009 Part 1 50 55 6
Part 2 1 5 10
("Item", "6/1/2009", "7/1/2009, "8/1/2009" are headers)
and produce the following results:
sheet2:
ColA ColB ColC
Part 1 50 6/1/2009
Part 1 55 7/1/2009
Part 1 6 8/1/2009
Part 2 1 6/1/2009
Part 2 5 7/1/2009
Part 2 10 8/1/2009
As my lack of knowledge regarding macros is abundant, perhaps this is an entirely different macro than the first you provided. No matter what, I appreciate your guidence and effort!
copy data in sheet1 to sheet 3 WHEN YOU FINALLY USE THIs macro IN YOUR ORIGINAL FILE PLEASE KEEP A COPY SAFELY SOMEWHERE.
In the macro there is a staemnt
m=3
you can change it if you want (but first test the macro as it is )
The macro is
Sub test()
Dim j As Integer, k As Integer
Dim m As Integer
m = 3
Worksheets("sheet1").Cells.Clear
Worksheets("sheet3").Cells.Copy
Worksheets("sheet1").Range("A1").PasteSpecial
Worksheets("sheet1").Activate
j = Range("a1").End(xlDown).Row
For k = j To 2 Step -1
Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).EntireRow.Insert
Cells(k, 1).EntireRow.Copy
Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).PasteSpecial
Next k
Application.CutCopyMode = False
Range("A1").Select
End Sub
quote
I would really like to use this - it's exactly what I'm trying to do (putting the results onto a new page). But I keep getting errors. Any ideas? I need to paste the value in column A the # of times listed in Column B into Sheet2
unquote
It is very confusing to me. please start a new thread in the newsgroup and explain clearly your requirements. Some macros are customized for certain files
Sub test()
Dim n As Integer, rng As Range
n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
Range(rng.Offset(1, 0), rng.Offset(3, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"
End Sub
it works great, but only for the first row, after that, it doesn't pick up the second row, and copy down n times. Is there a way to loop through until all originals rows are copied/pasted n times?
I love the way VB works, I just wish I could program using it. Thank you so much for all your help.
it works in my case. do an experiment open a new workbook.
type a in a1 and s in A2 and d in a3 and f in a4. now copy paste my macro in this workbook's vb editor and then run the macro . in the inptbox type for example 3 . Do you not get what you want . that is a repated 3 tiems, s repeated 3 times etc.
Then you can find out what is the problem in your workbook
1.open your file
2. open vb editor (alt+F11)
3.control+R
4.in the left side window highlight your file name
5. click insert(in the menu bar of vb editor)-module
6.there you copy paste the macro
7. save teh file
8. now you run the macro( I am sure you know how to do it)
I have a problem that might be similar to the history in this forum entry.
I create a forecast for parts in a cross tabular format (example below)
ColA ColB ColC ColD ColE
Part 1 Month1 Month2 Month3 Month4
Part 2 Month1 Month2 Month3 Month4
Part 2 Month1 Month2 Month3 Month4
To load the forecast into my Enterprise software program, I need the data to be tabular:
ColA ColB
Part 1 Month1
Part 1 Month2
Part 1 Month3
Part 1 Month4
Part 2 Month1
Part 2 Month2
Part 2 Month3
Part 2 Month4
Part 3 Month1
Part 3 Month2
Part 3 Month3
Part 3 Month4
Part 4 Month1
Part 4 Month2
Part 4 Month3
Part 4 Month4
The number of "parts" varies month to month; I would like to define it when the macro first runs. In my example, there were 4 parts.
Most of the time I create a forecast for '12 months' but it would be more useful to also define the date range when the macro runs. In my example, there were just 4 months.
Finally, I would prefer that the macro paste the data in a 'new worksheet' (rather than over write my forecast data worksheet).
I am only self taught. that is why I am not an expert. I suggest to learn vba just RECORD macro following the steps you want take and edit the macro This is the best way to learn vba. any doubt go to google search. and also take help of forums.
Just following your thread there about copying and inserting rows as per a condition. Sorry to innundate you with similar questions, but I have a similar problem to solve but with a slight twist and that is
I need the macro to work out the interval between two dates (start & End date) which I input and then accordingly duplicate the record that many times so lets
the number of days between 23/09 and 25/09 is 3 (inclusive of 25th) the I need the macro to first copy and insert three rows of the same data lets say which is on row 16, except that the start date on each of those 3 rows changes until it is equal to the end date.
It's a bit of twister for me as a complete newbie, I have been getting along all this while recording macros, but this one will not take a mouse click for an answer. Any help in this regard will be greatly appreciated.
1. how is row no. 16 configure . does this row contain the date or only with out date
2. how are you going to input start and end date
give an example of row no 13 if necessary with fictitious data
yes row 16 will contain both start and end dates.
The input for both is coming through a combo box in a form
This will be the 1st row of records I keep inserting rows to add more data.
Start Date End Date Start Time End Time Group Sub Group Details Manager
23-09-09 25-09-09 10:00 AM 11:00 AM Class X section 1 Goes for preparation Teacher 1
So in this case when a button is clicked I would need the final rows to look something like this
Start Date End Date Start Time End Time Group Sub Group Details Manager
23-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1
24-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1
24-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1
with the change being that the start dates will increment and show +1 day until it becomes equal to the end date.
I'm trying to do something very similar but MUCH simpler I think.
I would like to use cell A1 to put text into, Cell B1 to put the n number of times to repeat cell A1, and have the output added to column C
For example:
ColA ColB ColC
A1 text 5 A1 text
A1 text
A1 text
A1 text
A1 text
Then you leave Col C alone and clear out A and B. Put in new input to get the following for example:
ColA ColB ColC
A1new 7 A1 text
A1 text
A1 text
A1 text
A1 text
A1new
A1new
A1new
A1new
A1new
A1new
A1new
</code>
You can keep using it to create one big long column of entries. I'd gladly send someone some $$ via paypal for the help if it's done in the next few hours.
Sub test()
Dim x As Integer, r As Range, r1 As Range, c As Range
Dim dest As Range
Set r = Range(Range("A1"), Range("A1").End(xlDown))
For Each c In r
x = Cells(c.Row, "B").Value
Set dest = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
Set r1 = Range(dest, dest.Offset(x - 1, 0))
r1.FormulaArray = c.Value
Next c
Range(Range("c2"), Range("c2").End(xlDown)).Cut Range("c1")
End Sub
the result will be
A1 text 5 A1 text
a1 new 7 A1 text
A1 text
A1 text
A1 text
a1 new
a1 new
a1 new
a1 new
a1 new
a1 new
a1 new
I guess that the members of this newsgroup are volunteers.
I would really like to use this - it's exactly what I'm trying to do (putting the results onto a new page). But I keep getting errors. Any ideas? I need to paste the value in column A the # of times listed in Column B into Sheet2
the thread has become too long and dated also. for the next problem start a new thread
the data base is like this
hdng1 hdng2 hdng3
Test1 Test2 2
Test3 Test4 3
copy this data in sheet 3----IMPORTANT
WHEN YOU WANT TO RUN THE MACRO TO YOUR ORIGINAL FILE KEEP A COPY SAFELY SOMEWHERE SO THAT IF THERE IS A MESS UP THE ORIGINAL DATA CAN BE RETRIEVED
the macro is
Sub test()
Dim r As Range, c As Range, j As Long, k As Long, m As Long
Worksheets("sheet1").Cells.Clear
Worksheets("sheet3").Cells.Copy Worksheets("sheet1").Range("A1")
Worksheets("sheet1").Activate
Set r = Range(Range("A2"), Range("B2").End(xlDown))
j = Range("A2").End(xlDown).Row
'j is last row
For k = j To 2 Step -1
m = Cells(k, "C")
'MsgBox m
Range(Cells(k + 1, "A"), Cells(k + m - 1, "A")).EntireRow.Insert
Range(Cells(k, "A"), Cells(k, "B")).Copy
Range(Cells(k, "D"), Cells(k + m - 1, "d")).PasteSpecial
Next k
Application.CutCopyMode = False
Range("A1").Select
End Sub
The macro you provided below is really close to what I need.
Sub test()
Dim n As Integer, rng As Range
n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
Range(rng.Offset(1, 0), rng.Offset(3, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"
End Sub
My data is formatted a little differently I think. My data is currently provided as:
