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

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
675
Office Version
  1. 2016
Platform
  1. MacOS
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.

Code:
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
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,376
Office Version
  1. 2019
Platform
  1. Windows
Hi,
untested but see if this update to your find code does what you want

Code:
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

Well-known Member
Joined
Apr 9, 2010
Messages
675
Office Version
  1. 2016
Platform
  1. MacOS
@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.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,632
Messages
5,597,287
Members
414,134
Latest member
Tiyas44

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top