Absolute to Relative Cell Referencing Macro Help!

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.

Sub 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

http://www.mediafire.com/?p2lu94helhd5g4y

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?

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

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?

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