Hello everyone,
I really couldn't find anything on this in the search, so I really hope I'm not beating a dead horse with this one.
I am trying to create a macro that will automatically copy data from a cell and paste it in a list in another worksheet. Let me explain a bit more;
I am creating a workbook that takes stock prices/highs-lows/change%/etc. for a certain company and assimilating that data into separate worksheets for each category. The stock information is imported directly via "refreshable stock price" feature in excel. So the worksheet this data is imported in is refreshed in the macro and then I manually copy and pasted each entity into it's respective category worksheet. So when you hit the "Update" button it refreshes copy/paste all data over and over again. The problem I am having is that the imported data is supposed to be an absolute reference and the other worksheets that store the data over time should be pasted with relative references to create the list. My VB knowledge is fairly limited and I tried using the "Use Relative References" button by switching it on and off when I am copying and pasting but when I run the macro it is not working. It just pastes the cells over and over.
Here is the macro ( I didn't have time to clean it up so there might be some redundant coding in there) Also I did some formatting stuff at the end that can be ignored I think. Any help will be greatly appreciated.
http://www.mediafire.com/?p2lu94helhd5g4ySub UpdateTest() ' ' UpdateTest Macro ' ' Range("E5").Select Selection.Copy Sheets("Daily Close").Select ActiveCell.Offset(1, 1).Range("B2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.ClearContents ActiveCell.Select Range("B2").Select Sheets("Company Profiles").Select Range("E5").Select Selection.Copy Sheets("Daily Close").Select ActiveCell.Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("E15").Select Application.CutCopyMode = False Selection.Copy Sheets("Daily Close").Select Range("C2").Select ActiveSheet.Paste Sheets("Daily Close").Select Range("C2").Select Application.CutCopyMode = False Selection.ClearContents Sheets("Company Profiles").Select Selection.Copy Sheets("Daily Close").Select ActiveCell.Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("Q5").Select Application.CutCopyMode = False Selection.Copy Sheets("Shares Out").Select ActiveCell.Offset(1, 1).Range("A1").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("Q15").Select Application.CutCopyMode = False Selection.Copy Sheets("Shares Out").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("K5").Select Application.CutCopyMode = False Selection.Copy Sheets("Change %").Select Range("B2").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("K15").Select Application.CutCopyMode = False Selection.Copy Sheets("Change %").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("G5").Select Application.CutCopyMode = False Selection.Copy Sheets("Daily High").Select ActiveCell.Offset(1, 1).Range("A1").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("G15").Select Application.CutCopyMode = False Selection.Copy Sheets("Daily High").Select Range("C2").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("H5").Select Application.CutCopyMode = False Selection.Copy Sheets("Daily Low").Select ActiveCell.Offset(1, 1).Range("A1").Select ActiveSheet.Paste Sheets("Company Profiles").Select Range("H15").Select Application.CutCopyMode = False Selection.Copy Sheets("Daily Low").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste Sheets("Daily Close").Select Range("B2:C61").Select Application.CutCopyMode = False Selection.ClearFormats Sheets("Shares Out").Select Range("B2:C61").Select Selection.ClearFormats Selection.NumberFormat = "#,##0" Sheets("Change %").Select Range("B2:C61").Select Selection.ClearFormats Selection.NumberFormat = "0.00%" Sheets("Daily High").Select Range("B2:C61").Select Selection.ClearFormats Sheets("Daily Low").Select Range("B2:C61").Select Selection.ClearFormats Range("A1").Select Sheets("Daily High").Select Range("A1").Select Sheets("Change %").Select Range("A1").Select Sheets("Shares Out").Select Range("A1").Select Sheets("Daily Close").Select Range("A1").Select Sheets("Company Profiles").Select Range("A1").Select Sheets("Control Panel").Select Range("A1").Select
Last edited by Cele; 01-24-2012 at 09:39 PM.
Unfortunately your post does not comply with the forum rules. Can wrap you code in code tags, see my sig for details. And if it is possible, could you post a sample file and what you would like to achieve to help your problem?
If you are happy with the answer, please click the Star icon in the below left hand corner.
Good sites to start learning.
snb's VBA Help Files
Jerry Beaucaires Excel Assistant
J & R Excel Consultancy Services
How to post code correctly: Correct Code Posting
Sorry about that, I kind of rushed through the post.
Let me know if you need any additional info. As you can see in the VB code, it is pretty scrambled and I had a couple of attempts at it in there. I'm trying to create a macro that will copy the data of the stock in the 'Company Sheet' and paste it into each individual sheet to keep proceeding the 'company profile' one. This will create a long list of stock info for each date and for each company that I add so I can compile the data so I can do whatever with the data like run regressions or forecasts etc.
The media file link is the spreadsheet in it's current form. Let me know if there is a better way to provide a sample file.
OK, see the attached workbook.
Up the top of the Company Profile worksheet is a button "update" . Press this and it will give you the values for that date. The data is in cell "B2" and I have set it to automatically update each day, so if you are entering data once a day for that days trading it will automatically update for you. There is a prompt that allows you to overwrite today's data if you mistakenly upload the wrong data and want to change it. Clicking no will allow fresh data to be added to the sheets.
If you want to play around with the dates, you can manually enter the date in cell "B2" to test the code.
Sub n() Dim wsD As Worksheet, wsS As Worksheet, wsC As Worksheet, wsCP As Worksheet Dim wsDH As Worksheet, wsDL As Worksheet, ws As Worksheet Dim LR&, i&, rng As Range, D As String, mBox As String Dim cel As Range, dDate As Range, row As Variant On Error Resume Next Set wsD = Sheets("Daily Close") Set wsS = Sheets("Shares Out") Set wsC = Sheets("Change %") Set wsDH = Sheets("Daily High") Set wsDL = Sheets("Daily Low") Set cel = Sheets("Company Profiles").Cells(1, 2) Application.ScreenUpdating = 0 LR = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).row mBox = MsgBox("Do you want to overwrite the selected dates values? Selecting no will add new Data.", vbYesNo, "Copy Data") For Each ws In ActiveWorkbook.Worksheets If ws.Name <> "Company Profiles" Then If dDate <> vbNullString Then If mBox = vbYes Then Set dDate = wsD.Range("A2:A" & LR).Find(what:=cel, LookIn:=xlValues, LookAt:=xlWhole) If cel = dDate Then row = dDate.Address ws.Range(row).EntireRow.Delete Else: Exit Sub End If End If End If End If Next ws If mBox = vbNo Then LR = LR + 1 With ActiveSheet D = .Cells(1, 2).Value For i = 5 To 17 Set rng = .Cells(4, i) Select Case rng Case "Last" wsD.Cells(LR, 1).Value = D wsD.Cells(LR, 2).Value = .Cells(5, i).Value wsD.Cells(LR, 3).Value = .Cells(15, i).Value Case "High" wsDH.Cells(LR, 1).Value = D wsDH.Cells(LR, 2).Value = .Cells(5, i).Value wsDH.Cells(LR, 3).Value = .Cells(15, i).Value Case "Low" wsDL.Cells(LR, 1).Value = D wsDL.Cells(LR, 2).Value = .Cells(5, i).Value wsDL.Cells(LR, 3).Value = .Cells(15, i).Value Case "% Change" wsC.Cells(LR, 1).Value = D wsC.Cells(LR, 2).Value = .Cells(5, i).Value wsC.Cells(LR, 3).Value = .Cells(15, i).Value Case "# Shares Out" wsS.Cells(LR, 1).Value = D wsS.Cells(LR, 2).Value = .Cells(5, i).Value wsS.Cells(LR, 3).Value = .Cells(15, i).Value End Select Next i End With Application.ScreenUpdating = 1 End Sub
Last edited by JapanDave; 01-25-2012 at 10:45 AM.
If you are happy with the answer, please click the Star icon in the below left hand corner.
Good sites to start learning.
snb's VBA Help Files
Jerry Beaucaires Excel Assistant
J & R Excel Consultancy Services
How to post code correctly: Correct Code Posting
Wow, I can't thank you enough. This is so simple but so much more effective then my attempt. I really need to build up my VB knowledge. I am so impressed. Thank you!!
Would it be very hard to add additional items or companies to your code?
Last edited by Cele; 01-25-2012 at 07:32 PM.
Have a look at the new workbook. If you keep the same format for each company information, you can add as many companies as like at any time you need. The code will automatically adjust for the added companies data. But, I stress that you can't change the format of the Companies profiles sheets, you can add as much data going down the page, but you can't add across the page. With the other pages that you are transferring data to, you can add the companies name across the page in the order that they are in on the companies profile sheet.
Sub n() Dim wsD As Worksheet, wsS As Worksheet, wsC As Worksheet, wsCP As Worksheet Dim wsDH As Worksheet, wsDL As Worksheet, ws As Worksheet Dim LR&, i&, rng As Range, D As String, mBox As String Dim cel As Range, dDate As Range, row As Variant, y&, z&, str As String On Error Resume Next Set wsD = Sheets("Daily Close") Set wsS = Sheets("Shares Out") Set wsC = Sheets("Change %") Set wsDH = Sheets("Daily High") Set wsDL = Sheets("Daily Low") Set cel = Sheets("Company Profiles").Cells(1, 2) Application.ScreenUpdating = 0 LR = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).row mBox = MsgBox("Do you want to overwrite the selected dates values? Selecting no will add new Data.", vbYesNo, "Copy Data") For Each ws In ActiveWorkbook.Worksheets If ws.Name <> "Company Profiles" Then If dDate <> vbNullString Then If mBox = vbYes Then Set dDate = wsD.Range("A2:A" & LR).Find(what:=cel, LookIn:=xlValues, LookAt:=xlWhole) If cel = dDate Then row = dDate.Address ws.Range(row).EntireRow.Delete Else: Exit Sub End If End If End If End If Next ws If mBox = vbNo Then LR = LR + 1 With ActiveSheet D = .Cells(1, 2).Value For i = 5 To 17 y = 5 z = 2 str = .Cells(y, i).Value Do Until str = "" Set rng = .Cells(4, i) Select Case rng Case "Last" wsD.Cells(LR, 1).Value = D wsD.Cells(LR, z).Value = .Cells(y, i).Value Case "High" wsDH.Cells(LR, 1).Value = D wsDH.Cells(LR, z).Value = .Cells(y, i).Value Case "Low" wsDL.Cells(LR, 1).Value = D wsDL.Cells(LR, z).Value = .Cells(y, i).Value Case "% Change" wsC.Cells(LR, 1).Value = D wsC.Cells(LR, z).Value = .Cells(y, i).Value Case "# Shares Out" wsS.Cells(LR, 1).Value = D wsS.Cells(LR, z).Value = .Cells(y, i).Value End Select y = y + 10 z = z + 1 str = .Cells(y, i).Value Loop Next i End With Application.ScreenUpdating = 1 End Sub
If you are happy with the answer, please click the Star icon in the below left hand corner.
Good sites to start learning.
snb's VBA Help Files
Jerry Beaucaires Excel Assistant
J & R Excel Consultancy Services
How to post code correctly: Correct Code Posting
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Reply With Quote
Bookmarks