VBA Help - Need to Add an If Statement to my Working Code - Add value if not found

[Johnny Thunder]

Hi Everyone, I am wrapping up a project and need a little help with adding an if statement to my code, not sure the best way to do this so was hoping for some help.

Background
Using the find method the code loops thru a list of values in sheet "DataSource" and when a value is matched on Sheet "Manual Adjustments" it enter a $amount from the "Datasource" sheet.


What I need to add to this working code is an If Statement for the find method, that in the event a value is not found from the DataSource tab, the code needs to go to Sheets "Manual Adjustments", find the LastRow+1 in Column A and add the New Value.

Option Explicit
Sub ManlAdjustments()


Dim results     As Range, CurrCell As Range, currValue As Range, rCell As Range
Dim ws1         As Worksheet, ws2 As Worksheet
Dim LastRow     As Long, lrow As Long


Set ws2 = Sheets("DataSource") 'DataSource
Set ws1 = Sheets("Manual Adjustment") 'Sheet to insert new values if found


LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row 'datasource Lastrow
lrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row 'Adjustments Lastrow
Set results = ws2.Range("A11:A" & LastRow & "")


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Call Clear_Highlighting ' Clears sheet of any highlighted cells


For Each rCell In results
    If rCell <> "" Then
    
Set CurrCell = rCell
Set currValue = CurrCell.Offset(0, 4)
    
With ws1 'This block searches for the value that is defined in the column A from the "Datasource" Tab
.Activate
    .Cells.Find(What:=CurrCell.Value, After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate


    ActiveCell.Offset(0, 7).Value = -currValue.Value ' "-" makes the values negative, remove to go back to original value
    ActiveCell.EntireRow.Interior.ColorIndex = 6 ' Highlights entire row when it adds an entry
 End With


'Add code to enter new value if not found
 
 End If
     
     Next rCell


Application.ScreenUpdating = True
Application.DisplayAlerts = True
    
    
End Sub

 

[dmt32]

Hi,
untested but see if this update to your find code does what you want

For Each rCell In results
        If rCell <> "" Then
            
            Set CurrCell = rCell
            Set currValue = CurrCell.Offset(0, 4)
            
            Dim FoundCell As Range
'This block searches for the value that is defined in the column A from the "Datasource" Tab
            Set FoundCell = ws1.Columns(1).Find(What:=CurrCell.Value, After:=ActiveCell, LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
            If Not FoundCell Is Nothing Then
                
                With FoundCell
                    .Offset(0, 7).Value = -currValue.Value ' "-" makes the values negative, remove to go back to original value
                    .EntireRow.Interior.ColorIndex = 6 ' Highlights entire row when it adds an entry
                End With
                
            Else
'Added code to enter new value if not found
                lrow = lrow + 1
                ws1.Cells(lrow, 1).Value = CurrCell.Value
            End If
        End If
        Set FoundCell = Nothing
        Next rCell
        
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        
        
End Sub

Dave

 

[Johnny Thunder]

@dmt32 The updates worked out great, thanks again for all your help! it helped get me to the next step of the project. I added in a few small changes after your updates to complete the project.

Here is the final product with your update included.

What its doing
Code looks at a list of values and compares it to a list of historic entries, when it finds a match, it will update a "$" amount in an offsetting column to the value ID it will also highlight the entire row as a visual notification that the row received updates. It also will insert any new Values at the lastrow and highlight the newly added values entire row. It then moves the subtotal row down based on how many new entries it has added and redifines the SUM formulas to include the newly added entries.

Sub ManlAdjustments()


Dim results     As Range, CurrCell As Range, currValue As Range, rCell As Range, SubRowRange As Range
Dim ws1         As Worksheet, ws2 As Worksheet
Dim LastRow     As Long, lrow As Long
Static Counter  As Integer, Subrow As Integer


Set ws2 = Sheets("DataSource") 'DataSource
Set ws1 = Sheets("Manual Adjustment") 'Sheet to insert new values if found
Set SubRowRange = Range("Subtotalws1")
Subrow = SubRowRange.Row


LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row 'datasource Lastrow
lrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row 'Adjustments Lastrow
Set results = ws2.Range("A11:A" & LastRow & "")


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Call Clear_Highlighting ' Clears sheet of any highlighted cells


For Each rCell In results
        If rCell <> "" Then
            
            Set CurrCell = rCell
            Set currValue = CurrCell.Offset(0, 4)
            
            Dim FoundCell As Range
'This block searches for the value that is defined in the column A from the "Datasource" Tab
            Set FoundCell = ws1.Columns(1).Find(What:=CurrCell.Value, After:=ActiveCell, LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
            If Not FoundCell Is Nothing Then
                
                With FoundCell
                    .Offset(0, 7).Value = -currValue.Value ' "-" makes the values negative, remove to go back to original value
                    .EntireRow.Interior.ColorIndex = 6 ' Highlights entire row when it adds an entry
                End With
                
            Else
'Added code to enter new value if not found
    lrow = lrow + 1
    Counter = Counter + 1
    ws1.Range(SubRowRange, SubRowRange.Offset(CInt(Counter - Counter), 0)).EntireRow.Insert 'Moves Subtotal Row down based on how many new entries are added
            
            ws1.Cells(lrow, 1).Value = CurrCell.Value 'Adds the new ID
            ws1.Cells(lrow, 8).Value = -currValue.Value 'Adds the $Amount for the New ID
            ws1.Cells(lrow, 1).EntireRow.Interior.ColorIndex = 6 'Highlights the new values entire row
    End If
    End If
        Set FoundCell = Nothing
        Next rCell
        
       With ws1 'Redifines the Subtotals Range
       .Range("Currtotal").Formula = "=Sum($I$5:I$" & lrow & ")"
       .Range("Pretotal").Formula = "=Sum($I$5:I$" & lrow & ")"
       End With
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
End Sub