Macro to lookup and insert (paste) data into the next empty cell below the found cell

S

sdoppke

Well-known Member
Joined
Jun 10, 2010
Messages
647
Hi everyone. Hoping you could help me with the title above. I am looking lookup a value (a number) in a cell and to instert data (just a string of text) into a the next empty cell (but no more than 7 cells below, if all are full then msgbox) below the found cell.

Thanks in advacne with any help with that. :)

sd
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Assuming the value you want to search is in cell B2, the following code will do what you want... You can replace Cells(2,2) with the string that you want to search for.
Code: 
findvalue = Cells(2, 2)
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    RowNum = ActiveCell.Row
    ColNum = ActiveCell.Column
    
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = "your string"
            Exit For
        Else
            If r = 7 Then
                MsgBox ("Dude! no luck :(")
            End If
            
        End If
    Next
 
Upvote 0
Code fixed to handle errors when value is not found
Code: 
findvalue = "abc"
    On Error GoTo finish
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    On Error GoTo 0
    RowNum = ActiveCell.Row
    ColNum = ActiveCell.Column
    
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = "your string"
            Exit Sub
        Else
            If r = 7 Then
                MsgBox ("Dude! no luck :(")
                Exit Sub
            End If
            
        End If
    Next
    
finish:
    Err.Clear
    MsgBox ("Dude! value not found :(")
 
Last edited:
Upvote 0
Saagar said:
Code fixed to handle errors when value is not found
Code: 
findvalue = "abc"
    On Error GoTo finish
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    On Error GoTo 0
    RowNum = ActiveCell.Row
    ColNum = ActiveCell.Column
 
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = "your string"
            Exit Sub
        Else
            If r = 7 Then
                MsgBox ("Dude! no luck :(")
                Exit Sub
            End If
 
        End If
    Next
 
finish:
    Err.Clear
    MsgBox ("Dude! value not found :(")
Click to expand...


Thank you so much for replying!! This is great, can i edit it to search a particular range only?
 
Upvote 0
Yes.

Use this
Rich (BB code): 
    'Select columns or rows or range
    'Range("A1:B5").Select
    Columns("A:D").Select
    'Search in selection
    Selection.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

instead of
Rich (BB code): 
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
 
Upvote 0
Saagar said:
Yes.

Use this
Rich (BB code): 
   'Select columns or rows or range
   'Range("A1:B5").Select
    Columns("A:D").Select
   'Search in selection
    Selection.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

instead of
Rich (BB code): 
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
Click to expand...


I cant tell you enough how much i appreciate you!!! thanks again.
 
Upvote 0
Saagar said:
Yes.

Use this
Rich (BB code): 
   'Select columns or rows or range
   'Range("A1:B5").Select
    Columns("A:D").Select
   'Search in selection
    Selection.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

instead of
Rich (BB code): 
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
Click to expand...

Sagaar, after thinking this through a bit more. I want to make sure the user cannot input the same name twice on the same date box (the 7 rows)

Appreciate any help on that. :)

sd
 
Upvote 0
Saagar said:
Code fixed to handle errors when value is not found
Code: 
findvalue = "abc"
    On Error GoTo finish
    Cells.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    On Error GoTo 0
    RowNum = ActiveCell.Row
    ColNum = ActiveCell.Column
 
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = "your string"
            Exit Sub
        Else
            If r = 7 Then
                MsgBox ("Dude! no luck :(")
                Exit Sub
            End If
 
        End If
    Next
 
finish:
    Err.Clear
    MsgBox ("Dude! value not found :(")
Click to expand...

I bet it would be helpfull if i posted the script i adapted it to:
Code: 
Sub Input_Availability()
Application.ScreenUpdating = False
findvalue = Sheets("MyStoreInfo").ComboBox1.Value
If Sheets("MyStoreInfo").CheckBox1.Value = True Then
Box = "O"
End If
If Sheets("MyStoreInfo").CheckBox2.Value = True Then
Box = "P"
End If
If Sheets("MyStoreInfo").CheckBox3.Value = True Then
Box = "R"
End If
    On Error GoTo finish
    Range("Q10:AD49").Select
   Selection.Find(What:=findvalue, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
        , SearchFormat:=False).Activate
    On Error GoTo 0
    RowNum = ActiveCell.row
    ColNum = ActiveCell.Column
    
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = Range("B10") & " " & Range("C10")
            Cells(RowNum + r, ColNum + 1) = Box
            
'begin part that inputs the letter to Schedule Template
FindName = Sheets("MyStoreInfo").Range("B10") & " " & Sheets("MyStoreInfo").Range("C10")
FindNumber = Sheets("MyStoreInfo").ComboBox1.Value
If Sheets("MyStoreInfo").CheckBox1.Value = True Then
Box = "O"
End If
If Sheets("MyStoreInfo").CheckBox2.Value = True Then
Box = "P"
End If
If Sheets("MyStoreInfo").CheckBox3.Value = True Then
Box = "R"
End If
Sheets("Schedule Tool").Visible = True
Sheets("Schedule Tool").Select
    Columns("A:A").Select
    Range("A3").Activate
    On Error GoTo 0
    Selection.Find(What:=FindNumber, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.FindNext(After:=ActiveCell).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Find(What:=FindName, After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Select
        
    RowNum = ActiveCell.row
    ColNum = ActiveCell.Column
    Cells(RowNum, ColNum + 88) = Box
    Sheets("Schedule Tool").Visible = False
'end part that inputs the letter to Schedule Template
            Sheets("MyStoreInfo").Select
            Range("Q8").Select
            Application.ScreenUpdating = True
            Exit Sub
            
        Else
            If r = 7 Then
                Application.ScreenUpdating = True
                MsgBox ("No more room")
                Exit Sub
            End If
            
        End If
    Next
finish:
    Err.Clear
    MsgBox ("Date not found")
End Sub



Here is what I thought it would be, but definatly does not work:
Code: 
If Not Cells(RowNum + r, ColNum) = <> "" Or Range("B10") & " " & Range("C10") Then
 
Upvote 0
If I understood your requirement right, this should work

Rich (BB code): 
.
.
    putName = Range("B10") & " " & Range("C10")
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = putName
            Cells(RowNum + r, ColNum + 1) = Box

'begin part that inputs the letter to Schedule Template
.
.
'end part that inputs the letter to Schedule Template
.
.
            Exit Sub
        Elseif Cells(RowNum + r, ColNum) = putName then

                MsgBox ("Dude! Are you mad? You can't enter the name twice :x")
                Exit Sub

        Else
           If r = 7 Then
                Application.ScreenUpdating = True
                MsgBox ("No more room")
                Exit Sub
            End If
 
        End If
    Next
.
.
.
 
Upvote 0
Saagar said:
If I understood your requirement right, this should work

Rich (BB code): 
.
.
    putName = Range("B10") & " " & Range("C10")
    For r = 1 To 7
        If Cells(RowNum + r, ColNum) = "" Then
            Cells(RowNum + r, ColNum) = putName
            Cells(RowNum + r, ColNum + 1) = Box
 
'begin part that inputs the letter to Schedule Template
.
.
'end part that inputs the letter to Schedule Template
.
.
            Exit Sub
        Elseif Cells(RowNum + r, ColNum) = putName then
 
               MsgBox ("Dude! Are you mad? You can't enter the name twice :x")
               Exit Sub
 
        Else
           If r = 7 Then
                Application.ScreenUpdating = True
                MsgBox ("No more room")
                Exit Sub
            End If
 
        End If
    Next
.
.
.
Click to expand...


Genius!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Multiple columns lookup
Replies
0
Views
284
Sipirili2504
S
K
  • Question Question
Help Needed
2
Replies
13
Views
329
kwavic
K
J
  • Solved
Copy /past cells by inputbox on sheet 2 to sheet1 using VBA
2
Replies
12
Views
618
DanteAmor
DanteAmor
M
  • Solved
VBA to swap cell values, but enter the swapped value in cell below.
2
Replies
10
Views
722
myall_blues
myall_blues
Q
  • Question Question
Macro needed to insert 4 rows in table, copy data from above, copy data from another sheet and paste special (transpose values) to those new rows...re
Replies
1
Views
383
sijpie
sijpie

Forum statistics

Threads
1,224,606
Messages
6,179,866
Members
452,948
Latest member
UsmanAli786

Share this page

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