search in cell below previously found cell in VBA

[LSTR_94]

Hi all,

i'm pretty new to coding in VBA that's why i need your help.
the macro i want to make is like this:
i have multiple cells in column A from sheet2 that i need to find in column A from sheet1,
if found i want the macro to look at the cell below it and search for a amount of spaces in that cell, if this is the case then the full value of that cell should be copy and pasted in a new row under the cell from the first search.
so far i have programmed this but it gets stuck at the second find function:

Option Explicit
Sub search_for_SUB()
Dim i As Integer
Dim NumRows As Integer
Dim MG As String
Dim rng_MG As Range
Dim rng_SUBMG As Range
Dim SPACES As String
Dim submg As String

SPACES = " "

Application.ScreenUpdating = False
NumRows = Range("A10", Range("A10").End(xlDown)).Rows.Count
Range("A10").Select
For i = 10 To NumRows
Worksheets("sheet2").Activate

MG = ActiveCell.Value

Set rng_MG = Worksheets("sheet1").Cells.Find(what:=MG, _
LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)


If Not rng_MG Is Nothing Then
Set rng_SUBMG = Cells.Offset(1, 0).Find(what:=SPACES, _
LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rng_SUBMG Is Nothing Then

Else
GoTo skip
End If

Else
GoTo skip
End If
skip:
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub

i hope somebody could help me with this
thanks in advance

 

[ChrisFoster]

Try:

Option Explicit

Sub search_for_SUB()
    Dim i As Integer
    Dim NumRows As Integer
    Dim MG As String
    Dim rng_MG As Range
    Dim rng_SUBMG As Range
    Dim SPACES As String
    Dim submg As String
    Dim newRow As Long
    
    SPACES = " "
    
    Application.ScreenUpdating = False
    NumRows = Worksheets("sheet2").Range("A10", Range("A10").End(xlDown)).Rows.Count
    
    For i = 10 To NumRows
        Worksheets("sheet2").Activate
        MG = ActiveCell.Value
        
        Set rng_MG = Worksheets("sheet1").Cells.Find(what:=MG, _
            LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not rng_MG Is Nothing Then
            Set rng_SUBMG = Worksheets("sheet2").Cells.Offset(1, 0).Find(what:=SPACES, _
                LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not rng_SUBMG Is Nothing Then
                newRow = rng_MG.Row + 1
                rng_SUBMG.Offset(0, 1).Copy Destination:=Worksheets("sheet1").Cells(newRow, 1)
            End If
        End If
        
        ActiveCell.Offset(1, 0).Select
    Next
    
    Application.ScreenUpdating = True
End Sub