Using the Find method to copy 4 cell values above Find = X to another sheet for every value of X found in a column

[chazrab]

As stated above, this code finds all values of X and copies them to another sheet. Standard and straightforward. But I would like to
ask Excel to use the FIND method not only to find X but also copy the 4 values in the cell rows above(X.offset(-4,0?)
to another sheet for every value of X found:.

Private Sub cmdFIND_Click()
 Sheets("ALTVERSIONS").UsedRange.ClearContents
  Dim lastrow, lastrow2 As Integer, X As String, c As Range, rw As Long, firstAddress As Variant, rowno As Variant, RownoA As Variant
          X = Me.TextBox1.Value
                     With Worksheets("Sheet2").Range("E1:E31103")
                          Set c = .FIND(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
                               If Not c Is Nothing Then
                                        rw = 1
                                        firstAddress = c.Address
                                        Do
                                            Worksheets("Sheet2").Select
                                            c.Select
                                            Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy Destination:=Sheets("ALTVERSIONS").Range("B" & rw)
                                           rw = rw + 1
                                           Set c = .FindNext(c)
                                           Loop While Not c Is Nothing And c.Address <> firstAddress
                                            lastrow = Sheets("ALTVERSIONS").Range("B" & rows.count).End(xlUp).Row
                                            If lastrow = 1 Then
                                            Range(Cells(c.Row + 7, 2), Cells(c.Row, 7)).Copy Destination:=Sheets("ALTVERSIONS").Range("B" & rw)
                                            Else
                                            End If
                              Else
                                 MsgBox "value not found"
                              End If
                     End With
        End Sub

I tried to make this as eay as possible to understand. Not really difficult, just knowing how to ddjust this code
to just copy 4 cell value rows above X to another sheet for each value of X found with a row space between each set of 4 values for X

I worked on this several hours without success. Would really appreciate anyone's help.
Thanks
cr

 

[DanteAmor]

Try this:

Private Sub cmdFIND_Click()
  Dim shA As Worksheet
  Dim c As Range, rng As Range
  Dim X As String, firstAddress As String
  Dim rw As Long, lastrow As Long
 
  Set shA = Sheets("ALTVERSIONS")
  shA.UsedRange.ClearContents
  X = Me.TextBox1.Value

  With Worksheets("Sheet2")
    Set rng = .Range("E1:E31103")
    Set c = rng.Find(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
      rw = 1
      firstAddress = c.Address

      Do
        If c.Row > 4 Then
          .Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)
          rw = rw + 4
        End If
        Set c = rng.FindNext(c)
      Loop While c.Address <> firstAddress

      MsgBox "End"
    Else
      MsgBox "value not found"
    End If
  End With
End Sub

Some observations:
- Check if the way I indent the lines of my code is easier to read than the way you do it.
- In all range references, within the With statement you must put the dot:

.Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)

- To copy 4 rows before, it is necessary to check if the found row is greater than 4, otherwise it will send an error.

- I didn't understand the lines you have after the loop. With the new code there will no longer be only one line, there will be 5.
So it should be:

      lastrow = shA.Range("B" & Rows.Count).End(xlUp).Row
      If lastrow = 5 Then
        .Range(.Cells(c.Row + 7, 2), .Cells(c.Row + 7, 7)).Copy shA.Range("B" & rw + 1)
      End If

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[chazrab]

Try this:

Private Sub cmdFIND_Click()
  Dim shA As Worksheet
  Dim c As Range, rng As Range
  Dim X As String, firstAddress As String
  Dim rw As Long, lastrow As Long
 
  Set shA = Sheets("ALTVERSIONS")
  shA.UsedRange.ClearContents
  X = Me.TextBox1.Value

  With Worksheets("Sheet2")
    Set rng = .Range("E1:E31103")
    Set c = rng.Find(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
      rw = 1
      firstAddress = c.Address

      Do
        If c.Row > 4 Then
          .Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)
          rw = rw + 4
        End If
        Set c = rng.FindNext(c)
      Loop While c.Address <> firstAddress

      MsgBox "End"
    Else
      MsgBox "value not found"
    End If
  End With
End Sub

Some observations:
- Check if the way I indent the lines of my code is easier to read than the way you do it.
- In all range references, within the With statement you must put the dot:

.Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)

- To copy 4 rows before, it is necessary to check if the found row is greater than 4, otherwise it will send an error.

- I didn't understand the lines you have after the loop. With the new code there will no longer be only one line, there will be 5.
So it should be:

      lastrow = shA.Range("B" & Rows.Count).End(xlUp).Row
      If lastrow = 5 Then
        .Range(.Cells(c.Row + 7, 2), .Cells(c.Row + 7, 7)).Copy shA.Range("B" & rw + 1)
      End If

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Hi Dante - thx once again for your help as before - works great ! they say a picture is worth a thousand words. See images below. One little bug
in the last line of code you added, but its nothing major. I tried to show the location of where it bugged out with the clumsy snipping tools. A bit of an explanation. Oftentimes, a person does not fully understand the intended meaning of a phrase unless it is studied in context - the understanding follows when the previous verses above and sometimes below it are read - in this case, I did a search for the phrase,
'more will be given". Many, many people want to know more of what? The answer is found in the passages ABOVE that phrase hence 4 rows above like you modified in the code. By reading and studying the content above that phrase, the answer is revealed: it is "understanding". You have been a tremendous help in this effort as I continue to try to refine and improve this application. Finding any one word is easy for the code: finding a phrase or paragraph using a variable with the FIND method seems more challenging, but I'm sure its possible. Please comment if you feel led. Thanks again for all your help. Real simple fix - if you know what to do. cr

 

[DanteAmor]

One little bug
in the last line of code you added, but its nothing major.

In which of all the images is the problem? What does it say and what should it say?

Which last line of code are you referring to?


I await your comments and if I understand what the problem is, I will gladly fix it.
But first I must understand what the problem is.

 

[chazrab]

In which of all the images is the problem? What does it say and what should it say?

Which last line of code are you referring to?


I await your comments and if I understand what the problem is, I will gladly fix it.
But first I must understand what the problem is.

Gives the error message where cells is highlighted in blue in the actual error. Image below. I removed the dots before each 'cell' word as a test and it
ran without the compile error. Don't know why it accepted the "dot" in the code line above and generated the compile error in this line. Anyway, removing those dots in this last line made it run OK.

 

[DanteAmor]

Anyway, removing those dots in this last line made it run OK.

I'm glad to hear it's already working for you.

----

Just to clarify the problem a little.
Those lines must go inside the With - End With statement

Private Sub cmdFIND_Click()
  Dim shA As Worksheet
  Dim c As Range, rng As Range
  Dim X As String, firstAddress As String
  Dim rw As Long, lastrow As Long
 
  Set shA = Sheets("ALTVERSIONS")
  shA.UsedRange.ClearContents
  X = Me.TextBox1.Value

  With Worksheets("Sheet2")
    Set rng = .Range("E1:E31103")
    Set c = rng.Find(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
      rw = 1
      firstAddress = c.Address

      Do
        If c.Row > 4 Then
          .Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)
          rw = rw + 4
        End If
        Set c = rng.FindNext(c)
      Loop While c.Address <> firstAddress

      lastrow = shA.Range("B" & Rows.Count).End(xlUp).Row
      If lastrow = 5 Then
        .Range(.Cells(c.Row + 7, 2), .Cells(c.Row + 7, 7)).Copy shA.Range("B" & rw + 1)
      End If

      MsgBox "End"
    Else
      MsgBox "value not found"
    End If

  End With
End Sub

 

[chazrab]

I'm glad to hear it's already working for you.

----

Just to clarify the problem a little.
Those lines must go inside the With - End With statement

Private Sub cmdFIND_Click()
  Dim shA As Worksheet
  Dim c As Range, rng As Range
  Dim X As String, firstAddress As String
  Dim rw As Long, lastrow As Long
 
  Set shA = Sheets("ALTVERSIONS")
  shA.UsedRange.ClearContents
  X = Me.TextBox1.Value

  With Worksheets("Sheet2")
    Set rng = .Range("E1:E31103")
    Set c = rng.Find(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
      rw = 1
      firstAddress = c.Address

      Do
        If c.Row > 4 Then
          .Range(.Cells(c.Row - 4, 2), .Cells(c.Row, 7)).Copy shA.Range("B" & rw)
          rw = rw + 4
        End If
        Set c = rng.FindNext(c)
      Loop While c.Address <> firstAddress

      lastrow = shA.Range("B" & Rows.Count).End(xlUp).Row
      If lastrow = 5 Then
        .Range(.Cells(c.Row + 7, 2), .Cells(c.Row + 7, 7)).Copy shA.Range("B" & rw + 1)
      End If

      MsgBox "End"
    Else
      MsgBox "value not found"
    End If

  End With
End Sub

Corrected it. Works perfectly now!. Many thanks once again, for all your help.
cr