CODEWITHSUNDEEP
excelvba
Mark Romano
Mark Romano

Reputation: 711

Excel: VBA to copy values to specific row

I currently have a macro that copies the value from a specific cell from one sheet(BACKEND), and pastes in specific column in another sheet (EXPORT_DATA), in the next blank row.

Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1")

    Dim R As Range
    Dim col As Long
    col = Range(Source).Column

    Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp)
    If Len(R.Value) > 0 Then Set R = R.Offset(1)
    R.Value = Worksheets("BACKEND").Range(Source2).Value

End Sub

It works well, but I want to replace the the function in where it pastes the data in the next blank cell in a column, to a function in where it pastes the data in a row in where a cell holds a specified value.

For example, the older function would do the following

step 1:

c1    c2    c3
a     b     4
c     d     6

step 2 (after macro executed):

c1    c2    c3
a     b     4
c     d     6
c     d     5

But I need a new function that does this:

step 2 (C1 value of "c" specified, macro executed):

c1    c2    c3
a     b     4
c     d     5

Upvotes: 0

Views: 2636

Answers (3)

VBA Pete
VBA Pete

Reputation: 2666

Still not 100% certain, but I think this is what you are after. The file loop all values in column A of the EXPORT_DATA file and compared them to the value in cell A1 of the BACKEND worksheet. If it finds the value it replaces the value in column B, if it cannot find the value, it adds it at the end:

Sub copy_values_SINGLE()

Dim R As Range
Dim rowCount As Long
Dim varValue As Variant


rowCount = Application.WorksheetFunction.CountA(Worksheets("EXPORT_DATA").Range("A:A"))

For s = 1 To rowCount
    If Worksheets("EXPORT_DATA").Range("A" & s).Value = Worksheets("BACKEND").Range("A1").Value Then
    Worksheets("EXPORT_DATA").Range("A" & s & ":B" & s).Value = Worksheets("BACKEND").Range("A1:B1").Value
    Exit For
    Else
        If s = rowCount Then
        Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        R.Value = Worksheets("BACKEND").Range("A1:B1").Value
        End If
    End If
Next s

End Sub

Let me know if this works for you.

Upvotes: 0

Mark Romano
Mark Romano

Reputation: 711

This may work

Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1")

    Dim R As Variant
    Dim col As Long
    col = Range(Source).Column

    Dim mrn As String
    Dim FoundCell As Excel.Range
    Dim myVal As String

    R = Worksheets("BACKEND").Range(Source2).Text
    myVal = Worksheets("BACKEND").Range(Source2).Text
    mrn = Worksheets("BACKEND").Range("A5").Value
    Set FoundCell = Worksheets("EXPORT_DATA").Range("A:A").Find(what:=mrn, lookat:=xlWhole, searchdirection:=xlPrevious)

    If Not FoundCell Is Nothing Then
'        MsgBox (R & " " & col & " " & FoundCell.Row)
        Worksheets("EXPORT_DATA").Range("Q" & FoundCell.Row).Value = R
        Else
        MsgBox "error"
    End If

End Sub

Upvotes: 0

Captain Grumpy
Captain Grumpy

Reputation: 520

See how this goes for you. Not sure how you are calling etc but it should be a reasonable starting point. I only gave it a really quick test 

Sub copy_values_SINGLE(cValue As Variant, Optional Source As String = "A1", Optional Source2 As String = "A1")
' Not sure of what value type c in your question would be but expects a single value to test against the column provided as Source
' Requires cValue to be provided

    Dim R As Range
    Dim col As Long
    Dim destRow As Integer

    col = Range(Source).Column

    On Error Resume Next
    destRow = 0
    destRow = Worksheets("EXPORT_DATA").Columns(col).Find(cValue, SearchDirection:=xlPrevious).Row
    If destRow = 0 Then destRow = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp).Row + 1 ' if cValue isnt found reverts to the last row as per previous code
    On Error GoTo 0

    Set R = Worksheets("EXPORT_DATA").Cells(destRow, col)
    R.Value = Worksheets("BACKEND").Range(Source2).Value

End Sub

Upvotes: 1

Related Questions