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

 

[JackDanIce]

Not entirely clear what you mean or your code is doing, at a guess, try:

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

 

[bobsburgers]

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

 

[JackDanIce]

I think I understand what you mean, give this a try:

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

 

[GTO]

Could you post some sample before/after data?

 

[NoSparks]

Try this

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

 

[bobsburgers]

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!

 

[bobsburgers]

Try this

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

 

[bobsburgers]

Try this

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

 

[NoSparks]

Change

foundscan.Offset(0, 4).Activate

to

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