Find and Copy VBA Modification

bobsburgers

Board Regular
Joined
Jun 25, 2017
Messages
60
Hi, all!

I'm working on a small inventory tracking system, and have run into a bug that I can't find a solution to.

The "Item Return" function (button activated VBA macro) searches the active worksheet for a string and, once found, copies the string from Column D to Column H.

The bug that I have run into is when we have multiple occurrences of the same string in the active worksheet. My current code will find all occurrences, and complete the function until each occurrence has been found and copied from D to H. However, based on our standard operating procedures, we need to check in each item by hand.

With that said, is there anyway to modify the code below (or perhaps find a new way to go about this function) so that in the event of multiple occurrences, rather than automatically filling each corresponding H cell, the function simply activates the cell with the next occurrence?

I was thinking maybe some sort of constraint where the function only works if the copy destination (column H) is empty; however, I haven't been able to implement that myself.

Here is the code, and I have provide screenshots, examples, and worksheets if that helps!

Code:
Sub Item_Return()


    Dim scanstring As String
    Dim foundscan As Range
    Dim ws As Worksheet
    Dim foundscan_address As String
    
Set ws = ActiveSheet


scanstring = InputBox("Please enter a value to search for", "Enter value")


With ws.Columns("D")
    
    Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)
                      
    If Not foundscan Is Nothing Then
foundscan_address = foundscan.Address

Do
        foundscan.Offset(0, 4).Value = scanstring
        ws.Activate
        foundscan.Activate
        ActiveWindow.ScrollRow = foundscan.Row

        Set foundscan = .FindNext(foundscan)

Loop While Not foundscan Is Nothing And foundscan.Address <> foundscan_address

    Else
        MsgBox scanstring & "  was not found"
    End If
    
End With

End Sub

Thanks for the help everyone!! :cool:

Best,

Bob
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Not entirely clear what you mean or your code is doing, at a guess, try:
Code:
Sub Item_Return_v1()

    Dim x   As Long
    Dim str As String
    Dim rng As Range
    
    With ActiveSheet
        str = InputBox("Please enter a value to search for:", "Enter Value")
        x = .Cells(.Rows.Count, 4).End(xlUp).row
        Set rng = .Cells(1, 4).Resize(x).find(what:=str, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not rng Is Nothing Then
            If Len(rng.Offset(, 4).Value) = 0 Then rng.Offset(, 4).Value = str
            Set rng = Nothing
        Else
            MsgBox str & " was not found", vbExclamation, "Value Not Found"
        End If
    End With
        
End Sub
 
Last edited:
Upvote 0
Hi, JackDanIce -

Your code seems to work very well in terms of finding a scanstring and copying it to the correct location; however, my issue persists. I'm sorry if I'm not describing it clearly enough, it's a fairly specific process that I'm trying to replace with an excel worksheet.

While testing your code, I entered "123" into D5 and D6. When I ran your code, the function ran perfectly, and H5 was populated. At this point, I tried running the code to address the "123" in D6 but when I enter the string into the inputbox, row 6 is not changed. Is there a way to have the macro recognize that D5 has already been addressed, and to move on to the "123" in D6?

I hope that makes sense!! haha

Thanks again!

Best,

Bob
 
Upvote 0
I think I understand what you mean, give this a try:
Code:
Sub Item_Return_v1()

    Dim x   As Long
    Dim str As String
    Dim rng As Range
    
    With ActiveSheet
        str = InputBox("Please enter a value to search for:", "Enter Value")
        x = .Cells(.Rows.Count, 4).End(xlUp).row
        Set rng = .Cells(1, 4).Resize(x).find(what:=str, after:=.Cells(1, 4), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not rng Is Nothing Then
            If Len(rng.Offset(, 4).Value) = 0 Then
                rng.Offset(, 4).Value = str
            Else
                Set rng = .Cells(1, 4).Resize(x).find(what:=str, after:=rng, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                rng.Offset(, 4).Value = str
            End If
            Set rng = Nothing
        Else
            MsgBox str & " was not found", vbExclamation, "Value Not Found"
        End If
    End With
        
End Sub
 
Last edited:
Upvote 0
Could you post some sample before/after data?
 
Upvote 0
Try this
Code:
Sub Item_Return()
    Dim scanstring As String
    Dim foundscan As Range
    Dim ws As Worksheet
    Dim foundscan_address As String
    
Set ws = ActiveSheet

scanstring = InputBox("Please enter a value to search for", "Enter value")

With ws.Columns("D")
    Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)
                      
    If Not foundscan Is Nothing Then
        foundscan_address = foundscan.Address

        Do
            If foundscan.Offset(0, 4).Value = "" Then
                ws.Activate
                foundscan.Offset(0, 4).Activate
                ActiveWindow.ScrollRow = foundscan.Row
                Exit Sub
            End If
            Set foundscan = .FindNext(foundscan)
        Loop While Not foundscan Is Nothing And foundscan.Address <> foundscan_address
    Else
        MsgBox scanstring & "  was not found"
    End If
End With
End Sub
 
Upvote 0
Could you post some sample before/after data?

Hi, GTO -

Unfortunately I can't download any of MrExcel's tools to post examples right now because I'm on my work computer...

Would you be willing to trade over email?

Let me know - thanks!
 
Upvote 0
Try this
Code:
Sub Item_Return()
    Dim scanstring As String
    Dim foundscan As Range
    Dim ws As Worksheet
    Dim foundscan_address As String
    
Set ws = ActiveSheet

scanstring = InputBox("Please enter a value to search for", "Enter value")

With ws.Columns("D")
    Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)
                      
    If Not foundscan Is Nothing Then
        foundscan_address = foundscan.Address

        Do
            If foundscan.Offset(0, 4).Value = "" Then
                ws.Activate
                foundscan.Offset(0, 4).Activate
                ActiveWindow.ScrollRow = foundscan.Row
                Exit Sub
            End If
            Set foundscan = .FindNext(foundscan)
        Loop While Not foundscan Is Nothing And foundscan.Address <> foundscan_address
    Else
        MsgBox scanstring & "  was not found"
    End If
End With
End Sub

NoSparks, this is really great! It's incredibly close to exactly what I'm *trying* to describe! haha

Is there anyway to have basically this exact code, but instead of just populating the corresponding cell in Column H, have the macro copy the "scanstring" from the inputbox into Column H?

Thank you again so much, this is already very helpful!

Best,

Bob
 
Upvote 0
Try this
Code:
Sub Item_Return()
    Dim scanstring As String
    Dim foundscan As Range
    Dim ws As Worksheet
    Dim foundscan_address As String
    
Set ws = ActiveSheet

scanstring = InputBox("Please enter a value to search for", "Enter value")

With ws.Columns("D")
    Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)
                      
    If Not foundscan Is Nothing Then
        foundscan_address = foundscan.Address

        Do
            If foundscan.Offset(0, 4).Value = "" Then
                ws.Activate
                foundscan.Offset(0, 4).Activate
                ActiveWindow.ScrollRow = foundscan.Row
                Exit Sub
            End If
            Set foundscan = .FindNext(foundscan)
        Loop While Not foundscan Is Nothing And foundscan.Address <> foundscan_address
    Else
        MsgBox scanstring & "  was not found"
    End If
End With
End Sub

NoSparks, this is really great! It's incredibly close to exactly what I'm *trying* to describe! haha

Is there anyway to have basically this exact code, but instead of just populating the corresponding cell in Column H, have the macro copy the "scanstring" from the inputbox into Column H?

Thank you again so much, this is already very helpful!

Best,

Bob
 
Upvote 0
Change
Code:
foundscan.Offset(0, 4).Activate
to
Code:
foundscan.Offset(0, 4).Value = scanstring
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

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
Back
Top