1

I have the following code in order to insert a new row and populate with data. If I just run the code it works ok but I only want it to run if the date is not already in the column so I have encased it in an IF statement but it fails to execute:

Sub PasteValues()

    If Not IsError(Application.Match(Sheet10.[A1], Sheet6.[B1:65000], 0)) Then
        Rows("4:4").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B4").Select
        ActiveCell.FormulaR1C1 = "=LastUpdate!R[-3]C[-1]"
        Range("C5:AP5").Select
        Selection.Copy
        ActiveWindow.ScrollColumn = 1
        Range("C4").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Selection.Copy
        Range("B4:AP4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      End If

End Sub
1
  • I think you need application.worksheetfunction.match( but I would consider architect it without a worksheet function and just use code. Commented Apr 7, 2016 at 22:59

3 Answers 3

1

Example update of your code below, I just had to change how you were referencing the cells:

Sub PasteValues()

     Dim LookupValue As String

     Dim LookupRange As Range

     Set LookupRange = Sheets("Sheet6").Range("B1:B65000")

     LookupValue = Sheets("Sheet10").Range("A1").Value

     If Not IsError(Application.Match(LookupValue, LookupRange, 0)) Then

          your code...

     End If

end sub
Sign up to request clarification or add additional context in comments.

Comments

1

You can try this, the key is to use generic routine:

Sub Main()

    '//1.  find the last row of data rather than an arbituary row number.  Give your data range a name,
    '//    such as dataRange
    Dim lngLastRow  As Long
    Dim lngDataRow  As Long
    Dim dtMyDate    As Date
    Dim strTempAddr As String

    dtMyDate = ThisWorkbook.Worksheets("Sheet10").Range("A1").Value
    lngLastRow = FindLastRow(Range("dataRange").Address)
    strTempAddr = "B1:B" & lngLastRow
    lngDataRow = FindAddress(ThisWorkbook, "Sheet6", dtMyDate, strTempAddr)

    If lngDataRow = 0 Then
      '//value 0 means Date is not present so...
      '//do your row insert and data population.
    End If

End Sub

Purpose : Find the last roll of a continuous region of cells, ie, NO blanks in the region

It is of the form, for example: $D$11:$E$33

Function FindLastRow(strCurrentRegion As String) As Long
    Dim rowAdd       As String
    Dim lngLastRow   As Long

    rowAdd = Right$(strCurrentRegion, Len(strCurrentRegion) - (InStr(strCurrentRegion, ":") + 1))
    lngLastRow = Right$(rowAdd, Len(rowAdd) - InStr(rowAdd, "$"))
    FindLastRow = lngLastRow

End Function

Purpose : Find the value you are looking in a user specified range

Function FindAddress(ByRef oWkbk As Workbook, ByRef strWkshName As String, ByVal dtFindMyDate As Date, _
              ByRef strRangeToLookIn As String) As Long

    Dim oRange   As Range

    With oWkbk.Worksheets(strWkshName).Range(strRangeToLookIn)
      Set oRange = .Find(dtFindMyDate, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

      If oRange Is Nothing Then
         FindAddress = 0
      Else
         FindAddress = oRange.Row
      End If

    End With

End Function

Hope that helps.

Comments

0

Maybe try something like this:

Sub PasteValues()

Dim fRange as Range
Dim fVal as String

fVal = Sheets("Sheet10").Range("A1").Value

Set fRange = Sheets("Sheet6").Range("B1:B65000").Find(What:=fVal, After:=Range("B1"), LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)

If Not fRange Is Nothing Then
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=LastUpdate!R[-3]C[-1]"
    Range("C5:AP5").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 1
    Range("C4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Range("B4:AP4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  End If

End Sub

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.