Find and Copy VBA Modification

[bobsburgers]

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!

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!!

Best,

Bob

 

[bobsburgers]

Change

foundscan.Offset(0, 4).Activate

to

foundscan.Offset(0, 4).Value = scanstring

Thank you so much NoSparks! With the small scale tests, this seems to be absolutely perfect!

Now time to implement it into the running prototype and see how it holds up! Thank you again so much!!

Best,

Bob

 

[RZVPS]

Hello all,

I am working on a piece of VBA script which can copy files with a certain string in the file name form one folder to other. For eg.: all files which have something like 'finance' in its name should be copied over to another folder. Please help me out!

 

[GTO]

Greetings RZVPS and welcome to MrExcel

I would suggest you start your own thread, as it can get quite confusing for 'answerers' to be trying to answer multiple people in the same thread.

Hope that helps,

Mark

 

[bobsburgers]

Change

foundscan.Offset(0, 4).Activate

to

foundscan.Offset(0, 4).Value = scanstring

Hi, NoSparks!

Sorry, I thought I had replied - but this modification is perfect!

Time to start testing it on a larger scale - thank you again so much!!

Best,

Bob