VBA code to match and move value

[artz]

Hi,

In my workbook, I have a workheet named Download and another named Portfolio. On the Download worksheet, I can activate a webquery to download the latest prices for given stock. What I need is a VBA sub which will do the following:

Place the value contained in the last row of Download worksheet in column G, into the appropriate cell (row) in column K on the Portfolio worksheet. The appropriate row is determined by matching the value in M6 on the Download worksheet (stock symbol) to the row on the Portfolio worksheet containing the same symbol.

I'd like to place the code for this sub inside my Download() sub.

Can anyone in the Forum help with some VBA code to do this?

Thanks,

Art

 

[John_w]

For the last row in column G use:

    Dim LastRow As Long    
    With Sheets("Download")
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).row
    End With

I would then use the macro recorder and do a manual find (selecting a particular column if necessary to restrict the find) to generate the other piece of code and combine them with a bit of editing.

 

[artz]

John,

Thanks for your response. I thought about the macro editor too and recorded a macro and then edited it to get the following:

Sub Find_Copy()
'
' Find_Copy Macro
' Macro recorded 4/6/2011 by Art
'
'
    Sheets("Download").Select
    Range("G8").Select
    Selection.End(xlDown).Select
    Selection.Copy
    Sheets("Portfolio").Select
    Cells.Find(What:=Sheets("Download").Range("M6").Value, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Range("K9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

The problem is that when I run it, I get a 'subscript out of range' error. Do you have any ideas as to what is wrong?

Thanks,

Art

 

[John_w]

Where does the error occur? Try stepping through the code with F8. Try deleting the .Activate.

Which column(s) do you need to search to find the M6 value (stock symbol)?

You can get rid of the .Selects, and the Copy ... PasteSpecial can be replaced by a single statement to assign one cell value to another cell:

Sheets("Sheet1").Range("A1").Value = Sheets("Sheet2").Range("B1").Value

 

[artz]

John,

I added your code suggestion for finding the last row of column G:

Sub Find_Copy()
'
' Find_Copy Macro
' Macro recorded 4/6/2011 by Art
'
'
    Dim LastRow As Long

    Sheets("Download").Select

    'Range("G8").Select
    'Selection.End(xlDown).Select
    With Sheets("Download")
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
    Selection.Copy
End With
    Sheets("Portfolio").Select
    Cells.Find(What:=Sheets("Download").Range("M6").Value, after:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Range("K9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

When I step through the code, it works until: With Sheets("Download"), then I get the subscript error.

Also, if I remove .Activate, I get another error. The column to search to find the M6 value (stock symbol) is on Portfolio, starting at cell B2. B1 is a header.

In my macro, after using the built-in "find", I used the ---> arrow key to move over to column K where I pasted the data. I just realized also that we will need still need an offset function to paste the value in column K. Follow me?

Any thoughts?

Thanks,

Art

 

[John_w]

How about this:

Sub C_SS()

    Dim LastRow As Long
    Dim copyValue As Variant
    Dim stockSymbol As String
    Dim stockSymbolRange As Range
    
    With Sheets("Download")
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        copyValue = .Cells(LastRow, "G").Value
    End With
    
    stockSymbol = Sheets("Download").Range("M6").Value
    
    With Sheets("Portfolio")
        Set stockSymbolRange = .Columns("B:B").Find(What:=stockSymbol, LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not stockSymbolRange Is Nothing Then
            .Cells(stockSymbolRange.Row, "K").Value = copyValue
        Else
            MsgBox "Stock symbol " & stockSymbol & " not found in column B of Portfolio sheet"
        End If
        
    End With

End Sub

 

[artz]

Hi John,

Thank you, your code works perfectly! I have several more values that I need to copy over to the Portfolio sheet in addition to the value in column G. I tried adding a search copy/paste for column E (Download) to column L (Portfolio) to your code. It worked perfectly. See below:

Sub C_SS()

    Dim LastRow1 As Long
    Dim copyValue1 As Variant
    
    Dim LastRow2 As Long
    Dim copyValue2 As Variant
    
    Dim stockSymbol As String
    Dim stockSymbolRange As Range
    
    With Sheets("Download")
        LastRow1 = .Cells(.Rows.Count, "G").End(xlUp).Row
        copyValue1 = .Cells(LastRow1, "G").Value
        LastRow2 = .Cells(.Rows.Count, "E").End(xlUp).Row
        copyValue2 = .Cells(LastRow1, "E").Value
    End With
    
    stockSymbol = Sheets("Download").Range("M6").Value
    
    With Sheets("Portfolio")
        Set stockSymbolRange = .Columns("B:B").Find(What:=stockSymbol, LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not stockSymbolRange Is Nothing Then
            .Cells(stockSymbolRange.Row, "K").Value = copyValue1
            .Cells(stockSymbolRange.Row, "L").Value = copyValue2
        Else
            MsgBox "Stock symbol " & stockSymbol & " not found in column B of Portfolio sheet"
        End If
        
    End With

End Sub

Thanks again,

Art

 

[artz]

John,

Thought that we had it but came across something interesting. After I put your sub code into my download sub, it stopped working.

Here's what I found. In order to get your sub to work, I need to manually delete all the rows after the downloaded data, then your sub runs fine- puts all seven values (with my mods) into the correct rows and columns.

There seems to be something in the rows after the data this is confusing the "LastRow1 = .Cells(.Rows.Count, "C").End(xlUp).Row" calculation for finding the last row.

The rows after the data in all the columns used appear blank, but as I said earlier, the sub only works if I do a select (of the apparently blank rows) and delete.

Do you have any suggestions on how to fix this?

Thanks,

Art

 

[artz]

John,

For some reason that I don't see my data download code is apparently putting a "" in the row after the data. Sometimes, but not all the time. I can't figure this out. The End(xlup).Row finds this instead of the date or data value.

So, I reworked your code by adding isDate for one column's check and isNumeric for the remaining columns that we are getting the last value value in row for. It mostly works. When I run it "standalone", in it's sheet module, it works exactly as expected.

When I place it in Module 1 and call it at the end of the download code, it gives me a "type mismatch" error.

My code:

Sub C_SS()

    Dim LastRow1 As Variant
    Dim copyValue1 As Variant
    
    Dim LastRow2 As Long
    Dim copyValue2 As Variant
    
    Dim LastRow3 As Long
    Dim copyValue3 As Variant
     
    Dim LastRow4 As Long
    Dim copyValue4 As Variant
    
    Dim LastRow5 As Long
    Dim copyValue5 As Variant
    
    Dim LastRow6 As Long
    Dim copyValue6 As Variant
    
    Dim LastRow7 As Long
    Dim copyValue7 As Variant
    
    Dim stockSymbol As String
    Dim stockSymbolRange As Range

   
With Sheets("Download")

LastRow1 = Range("C" & Rows.Count).End(xlUp).Row
Do Until IsDate(Range("C" & LastRow1).Text) Or LastRow1 = 8 'first row after header row
    LastRow1 = LastRow1 - 1
LastRow2 = Range("G" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("G" & LastRow2).Text) Or LastRow2 = 8
    LastRow2 = LastRow2 - 1
LastRow3 = Range("E" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("E" & LastRow3).Text) Or LastRow3 = 8
    LastRow3 = LastRow3 - 1
LastRow4 = Range("F" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("F" & LastRow4).Text) Or LastRow4 = 8
    LastRow4 = LastRow4 - 1
LastRow5 = Range("N" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("N" & LastRow5).Text) Or LastRow5 = 8
    LastRow5 = LastRow5 - 1
LastRow6 = Range("O" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("O" & LastRow6).Text) Or LastRow6 = 8
    LastRow6 = LastRow6 - 1
LastRow7 = Range("T" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("T" & LastRow7).Text) Or LastRow7 = 8
    LastRow7 = LastRow7 - 1
    
  Loop
copyValue1 = .Cells(LastRow1, "C").Value
copyValue2 = .Cells(LastRow2, "G").Value
copyValue3 = .Cells(LastRow2, "E").Value
copyValue4 = .Cells(LastRow4, "F").Value
copyValue5 = .Cells(LastRow5, "N").Value
copyValue6 = .Cells(LastRow6, "O").Value
copyValue7 = .Cells(LastRow7, "T").Value

End With

    stockSymbol = Sheets("Download").Range("M6").Value
    
   With Sheets("Portfolio")
        Set stockSymbolRange = .Columns("B:B").Find(What:=stockSymbol, LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not stockSymbolRange Is Nothing Then
            .Cells(stockSymbolRange.Row, "K").Value = copyValue1
            .Cells(stockSymbolRange.Row, "L").Value = copyValue2
            .Cells(stockSymbolRange.Row, "M").Value = copyValue3
            .Cells(stockSymbolRange.Row, "N").Value = copyValue4
            .Cells(stockSymbolRange.Row, "T").Value = copyValue5
            .Cells(stockSymbolRange.Row, "U").Value = copyValue6
            .Cells(stockSymbolRange.Row, "W").Value = copyValue7
        Else
            MsgBox "Stock symbol " & stockSymbol & " not found in column B of Portfolio sheet"
        End If
        
    End With

End Sub

Have I got an issue or error with the declarations in the dim statements? Any help would be appreciated.

Thanks,

Art

 

[John_w]

Your Dim's look OK, though the row variables should be Long and I would give them more representative names like LastRowColC, LastRowColG, etc.

This piece of code looks wrong:

With Sheets("Download")

LastRow1 = Range("C" & Rows.Count).End(xlUp).Row
Do Until IsDate(Range("C" & LastRow1).Text) Or LastRow1 = 8 'first row after header row
    LastRow1 = LastRow1 - 1
LastRow2 = Range("G" & Rows.Count).End(xlUp).Row
 IsNumeric (Range("G" & LastRow2).Text) Or LastRow2 = 8
 
':
':

End With

LastRow1 = Range("C" & Rows.Count).End(xlUp).Row has no sheet qualifiers and is therefore using the active sheet, which is "Download" if that happens to be the active sheet, but I think your intention is that all Range references within the With ... End With block should refer to the With Sheets("Download"), and therefore the line should be:
LastRow1 = .Range("C" & .Rows.Count).End(xlUp).Row

same for all the other Range statements inside the With ... End With.

IsNumeric (Range("G" & LastRow2).Text) Or LastRow2 = 8

looks wrong. IsNumeric is normally part of a condition statement (If, or loop condition).