Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Hi,
I have the following data: ID# | Name | Supervisor 123 | Name1| SUP1 456 | Name2| SUP2 789 | Name3| SUP3 124 | Name4| SUP4 .................................. .................................. I want to create a Macro which would copy this data and paste 4 record each to a different location in the same sheet, i.e. after running th macro the data should look like: ID# | Name | Supervisor 123 | Name1| SUP1 123 | Name1| SUP1 123 | Name1| SUP1 123 | Name1| SUP1 456 | Name2| SUP2 456 | Name2| SUP2 456 | Name2| SUP2 456 | Name2| SUP2 789 | Name3| SUP3 789 | Name3| SUP3 789 | Name3| SUP3 789 | Name3| SUP3 ................ What I want is a macro which would copy the non empty cells and past them accordingly without telling it what all to paste, i.e. lets say i i added "name 5" in the list and also made some changes in "name2" i would copy all the data into the desired result!!!(without changing th other cells, i.e. just paste it to column a,b,c and thats it!) I also wanted to have a password to run the macro, i.e. only someon with the rights can run the macro!!! Could someone help me with this? Thanks Paritosh Meht -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
I'm not sure I understood your request. This is my
interpretation. As I read your post, you may have empty cells in the data. I therefore structured the code to exclude empty cells. Empty cells in the original data are deliberately excluded in the copied data. The code assumes that the headings ID#, Name and Supervisor are in Cells A1 to C1 respectively with the data starting immediately below. Four copies of each data set are created and copied to Column E. Change the range references to suit. Test the code with empty cells in the original data. Note that you will have to correct for wordwrap. Const Pwd As String = "monkey" Sub TestZZZ() Dim txt As String, i As Integer, ii As Integer Dim Rng As Range, C As Range, Rw As Integer '<<<<< Password entry i = 0 Do Until txt = Pwd txt = InputBox("Enter password to continue . . . ", "Password Entry") If txt = "" Then Exit Sub ElseIf txt < Pwd Then i = i + 1 If i = 3 Then MsgBox "Access denied !!! " & _ "Contact your administrator for access to this feature. ", _ vbInformation, "Access denied" Exit Sub End If MsgBox "Password failed. Please try again. ", vbExclamation, "Password entry" End If Loop '<<<<< Transfer data i = 0 Rw = Range("A65536").End(xlUp).Row Set Rng = Range("A2:A" & Rw).SpecialCells (xlCellTypeConstants) For Each C In Rng For ii = 1 To 4 Range(Cells(i + ii, 5), Cells(i + ii, 7)) = Range (C, C.Offset(, 2)).Value Next i = i + 4 Next End Sub Regards, Greg -----Original Message----- Hi, I have the following data: ID# | Name | Supervisor 123 | Name1| SUP1 456 | Name2| SUP2 789 | Name3| SUP3 124 | Name4| SUP4 .................................. .................................. I want to create a Macro which would copy this data and paste 4 records each to a different location in the same sheet, i.e. after running the macro the data should look like: ID# | Name | Supervisor 123 | Name1| SUP1 123 | Name1| SUP1 123 | Name1| SUP1 123 | Name1| SUP1 456 | Name2| SUP2 456 | Name2| SUP2 456 | Name2| SUP2 456 | Name2| SUP2 789 | Name3| SUP3 789 | Name3| SUP3 789 | Name3| SUP3 789 | Name3| SUP3 ................ What I want is a macro which would copy the non empty cells and paste them accordingly without telling it what all to paste, i.e. lets say if i added "name 5" in the list and also made some changes in "name2" it would copy all the data into the desired result!!! (without changing the other cells, i.e. just paste it to column a,b,c and thats it!) I also wanted to have a password to run the macro, i.e. only someone with the rights can run the macro!!! Could someone help me with this? Thanks Paritosh Mehta --- Message posted from http://www.ExcelForum.com/ . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Hi Greg,
Thanks a ton for the reply!!! I tried the code and it is working preet fine for me, I just had one question, can we have a system whete the names are i sheet2 and the pasting happens in sheet 1 (in the cells a to c)? Thanks a million for your help!!!! Paritos -- Message posted from http://www.ExcelForum.com |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Hi Greg,
Just one more help on the same issue, this code works fine for th first 4 entries, what changes do i make for it to copy the entire no blank entries in a column and paste them!!! Thanks again!! -- Message posted from http://www.ExcelForum.com |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Paritosh,
I tested the code and it works for all non-empty cells in Column A -- not just the first four (???). A specific example follows. The headings are in row 1 with Id Num, Name and Supervisor in cells A1 to C1 respectively. The data immediately follows as shown below. Gaps are deliberate indicating blank rows. Following the data list shown immediately below are the results of the macro run on these data. This is my interpretation of what you wanted. Is this not what you get from running the macro? <<<< Data Id Num Name Supervisor ID1 Name1 Sup1 ID2 Name2 Sup2 ID3 Name3 Sup3 ID4 Name4 Sup4 ID5 Name5 Sup5 ID6 Name6 Sup6 ID7 Name7 Sup7 ID8 Name8 Sup8 <<<<< Macro result in Column E ID1 Name1 Sup1 ID1 Name1 Sup1 ID1 Name1 Sup1 ID1 Name1 Sup1 ID2 Name2 Sup2 ID2 Name2 Sup2 ID2 Name2 Sup2 ID2 Name2 Sup2 ID3 Name3 Sup3 ID3 Name3 Sup3 ID3 Name3 Sup3 ID3 Name3 Sup3 ID4 Name4 Sup4 ID4 Name4 Sup4 ID4 Name4 Sup4 ID4 Name4 Sup4 ID5 Name5 Sup5 ID5 Name5 Sup5 ID5 Name5 Sup5 ID5 Name5 Sup5 ID6 Name6 Sup6 ID6 Name6 Sup6 ID6 Name6 Sup6 ID6 Name6 Sup6 ID7 Name7 Sup7 ID7 Name7 Sup7 ID7 Name7 Sup7 ID7 Name7 Sup7 ID8 Name8 Sup8 ID8 Name8 Sup8 ID8 Name8 Sup8 ID8 Name8 Sup8 As for your request to change the sheet to a different sheet, the following code will copy the data from the active sheet to Sheet("Sheet2") instead of to the active sheet. Change sheet names and cell references to suit and correct for wordwrap. '<<<<< Transfer data i = 0 Rw = Range("A65536").End(xlUp).Row Set Rng = Range("A2:A" & Rw).SpecialCells (xlCellTypeConstants) For Each C In Rng For ii = 1 To 4 With Sheets("Sheet2") .Range(.Cells(i + ii, 5), .Cells(i + ii, 7)) = Range(C, C.Offset(, 2)).Value End With Next i = i + 4 Next End Sub Regards, Greg |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Hi Greg
Thanks a million for your help, you really are amazing!!!!!!! just one last thing, now i am using the code so that i enter data i sheet 2(cells a, b and c) and the data gets copied to sheet 1 (agai cells a, b and c; I have made some changes in the code); I just want t leave one empty row in sheet 1 for the header and am not able to figur how to go about it!! Please help '<<<<< Transfer data i = 0 Sheets("Sheet2").Select Rw = Range("A65536").End(xlUp).Row Set Rng = Range("A2:A" & Rw).SpecialCells(xlCellTypeConstants) For Each C In Rng For ii = 1 To 4 With Sheets("Sheet1") .Range(.Cells(i + ii, 1), .Cells(i + ii, 3)) = Range(C, C.Offset( 2)).Value End With Next i = i + 4 Next End Sub Thanks again!! -- Message posted from http://www.ExcelForum.com |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Just change the first line i = 0 to i = 1.
Regards, Gre -- Message posted from http://www.ExcelForum.com |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with creating a VBA
Hey Greg,
Let me tell you that you are the BEST!!!!! Thanks a ton for your help, you have been of great help!!! Cheers Paritosh Mehta! --- Message posted from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
creating a new key | Excel Discussion (Misc queries) | |||
creating Yes,No | Excel Discussion (Misc queries) | |||
creating a pdf | Excel Discussion (Misc queries) | |||
Really need help creating pop ups | Excel Discussion (Misc queries) | |||
Creating | Excel Discussion (Misc queries) |