macro row based on cell value

[terrycr]

I am trying to write a macro that copies data from a form (Contractor Entry) and pastes it to a database (CONTRACTOR DATABASE).

When a record is edited, it requests the Employee ID# and finds that row on the database and copies that row number reference temporarily into cell "L1".

I need to then paste the copied data to the database on that row number (-1) that is referenced in cell "L1". If there is no value in "L1" that means it is a new entry and should then just paste to the last row -- as opposed to pasting over a previous record row

Help. My code is here--

Range("U5:AT5").Copy
Sheets("CONTRACTOR_DATABASE").Select

Dim R As Integer
R = Worksheets("CONTRACTOR ENTRY").Range("L1").value

'if there is a value in CONTRACTOR ENTRY L1>0 then (it represents a row number --- pastevalue to that row -1


If Worksheets("CONTRACTOR ENTRY").Range("L1") > 0 Then
Sheets("CONTRACTOR_DATABASE").Cells (R -1, 1)
Selection.PasteSpecial

End If

Else

'if there is no value in cell L1 then the following to just paste to next blank row

lMaxRows = Cells(Rows.Count, "A").End(xlUpSelection.PasteSpecial.Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'This returns to the contractor entry form and clears contents

Sheets("CONTRACTOR ENTRY").Select


Range("D3:M1").Select


Selection.ClearContents


' Should go to cell for Name and new entry
Range("D3").Select

 

[Colo]

Just organized your code like this. It doesn’t have to use variables for worksheets, but it is useful for the readability of the code, depending on the case. Not using the Select method makes code speed faster.

    Dim sh1 As Worksheet: Set sh1 = Sheets("CONTRACTOR ENTRY")
    Dim sh2 As Worksheet: Set sh2 = Sheets("CONTRACTOR_DATABASE")
    Dim R As Long, lMaxRows As Long

    R = sh1.Range("L1").Value
    sh1.Range("U5:AT5").Copy

    'if there is a value in CONTRACTOR ENTRY L1>0 then (it represents a row number --- pastevalue to that row -1
    If R > 0 Then
        sh2.Cells(R - 1, 1).PasteSpecial
    Else
        'if there is no value in cell L1 then the following to just paste to next blank row
        lMaxRows = sh2.Cells(Rows.Count, "A").End(xlUp).Row
        sh2.Range("A" & lMaxRows + 1).PasteSpecial Paste:=xlPasteValues

        'This returns to the contractor entry form and clears contents
        sh1.Range("D3:M1").ClearContents

        ' Should go to cell for Name and new entry
        Application.Goto sh1.Range("D3")
    End If

 

[terrycr]

Just organized your code like this. It doesn’t have to use variables for worksheets, but it is useful for the readability of the code, depending on the case. Not using the Select method makes code speed faster.

    Dim sh1 As Worksheet: Set sh1 = Sheets("CONTRACTOR ENTRY")
    Dim sh2 As Worksheet: Set sh2 = Sheets("CONTRACTOR_DATABASE")
    Dim R As Long, lMaxRows As Long

    R = sh1.Range("L1").Value
    sh1.Range("U5:AT5").Copy

    'if there is a value in CONTRACTOR ENTRY L1>0 then (it represents a row number --- pastevalue to that row -1
    If R > 0 Then
        sh2.Cells(R - 1, 1).PasteSpecial
    Else
        'if there is no value in cell L1 then the following to just paste to next blank row
        lMaxRows = sh2.Cells(Rows.Count, "A").End(xlUp).Row
        sh2.Range("A" & lMaxRows + 1).PasteSpecial Paste:=xlPasteValues

        'This returns to the contractor entry form and clears contents
        sh1.Range("D3:M1").ClearContents

        ' Should go to cell for Name and new entry
        Application.Goto sh1.Range("D3")
    End If

Thank you very much!

 

[bebo021999]

Try:

Option Explicit
Sub CopyRange()
Dim CopyRng As Range, DesRng As Range, rNum
Application.ScreenUpdating = False
With Worksheets("CONTRACTOR ENTRY")
    Set CopyRng = .Range("U5:AT5")
    rNum = .Range("L1").Value
End With
    With Worksheets("CONTRACTOR_DATABASE")
        If rNum > 1 Then
            Set DesRng = .Cells(rNum - 1, 1)
        ElseIf IsEmpty(rNum) Then
            Set DesRng = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    DesRng.Resize(1, CopyRng.Columns.Count).Value = CopyRng.Value
    End With
Worksheets("CONTRACTOR ENTRY").Activate
Range("D1:M3").ClearContents
Range("D3").Activate
Application.ScreenUpdating = True
End Sub

 

[terrycr]

Just organized your code like this. It doesn’t have to use variables for worksheets, but it is useful for the readability of the code, depending on the case. Not using the Select method makes code speed faster.

    Dim sh1 As Worksheet: Set sh1 = Sheets("CONTRACTOR ENTRY")
    Dim sh2 As Worksheet: Set sh2 = Sheets("CONTRACTOR_DATABASE")
    Dim R As Long, lMaxRows As Long

    R = sh1.Range("L1").Value
    sh1.Range("U5:AT5").Copy

    'if there is a value in CONTRACTOR ENTRY L1>0 then (it represents a row number --- pastevalue to that row -1
    If R > 0 Then
        sh2.Cells(R - 1, 1).PasteSpecial
    Else
        'if there is no value in cell L1 then the following to just paste to next blank row
        lMaxRows = sh2.Cells(Rows.Count, "A").End(xlUp).Row
        sh2.Range("A" & lMaxRows + 1).PasteSpecial Paste:=xlPasteValues

        'This returns to the contractor entry form and clears contents
        sh1.Range("D3:M1").ClearContents

        ' Should go to cell for Name and new entry
        Application.Goto sh1.Range("D3")
    End If

That worked beautifully, I just had to fix my pastspecial.... Thank you again.

 

[terrycr]

Try:

Option Explicit
Sub CopyRange()
Dim CopyRng As Range, DesRng As Range, rNum
Application.ScreenUpdating = False
With Worksheets("CONTRACTOR ENTRY")
    Set CopyRng = .Range("U5:AT5")
    rNum = .Range("L1").Value
End With
    With Worksheets("CONTRACTOR_DATABASE")
        If rNum > 1 Then
            Set DesRng = .Cells(rNum - 1, 1)
        ElseIf IsEmpty(rNum) Then
            Set DesRng = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    DesRng.Resize(1, CopyRng.Columns.Count).Value = CopyRng.Value
    End With
Worksheets("CONTRACTOR ENTRY").Activate
Range("D1:M3").ClearContents
Range("D3").Activate
Application.ScreenUpdating = True
End Sub

Thank you