CODEWITHSUNDEEP
vbaexcel
Laura Morris
Laura Morris

Reputation: 222

Excel VBA code does not execute when in if statement

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

Upvotes: 1

Views: 432

Answers (3)

Sam Gilbert
Sam Gilbert

Reputation: 1702

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

Upvotes: 1

Gerry
Gerry

Reputation: 89

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.

Upvotes: 1

TheGuyThatDoesn'tKnowMuch
TheGuyThatDoesn'tKnowMuch

Reputation: 1250

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

Upvotes: 0

Related Questions