0

I'd like some help if possible! Currently, it's causing the excel sheet to crash each time it runs, perhaps because the loop is not ending. Could anyone try helping me fix my code? All 4 sheets have under 5000 rows.

I currently have a workbook with 4 sheets(the number of sheets will change) and one more sheet called Results. I have managed to look for the string: "Employee Code:-" in Column B, and get the value in Column Y and Column K and paste it in Results A and B respectively. (starting in the 5th row of the Results sheet). (Moving to the next find if Column S and Column K have the same value).

I then would need the values from 3 and 4 rows below the "Employee Code" running from D to AN and pasting it alongside the values from S and K

Then leaving a line after the results have been pasted and repeating for the rest of the find values.

Sub FindAndExecute()

Dim Sh As Worksheet
Dim Loc As Range
Dim i,j As Integer

i = 5
For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
    Set Loc = .Cells.Find(What:="Employee Code:-")
        If Not Loc Is Nothing Then
            Do Until Loc Is Nothing
                If Loc.Offset(0, 9).Value <> Loc.Offset(0, 23).Value Then
                Sheets("Result2").Cells(i, 1).Value = Loc.Offset(0, 9).Value
                Sheets("Result2").Cells(i, 2).Value = Loc.Offset(0, 23).Value
                j = 3
                Do
                Sheets("Result2").Cells(i, j).Value = Loc.Offset(3, j - 1).Value
                Sheets("Result2").Cells(i + 1, j).Value = Loc.Offset(4, j - 
                1).Value
                j = j + 1
                Loop Until j > 35
                i = i + 3
                Else
                End If
            Set Loc = .FindNext(Loc)
            Loop
        End If
    End With
    Set Loc = Nothing
Next

End Sub
Karan Saraogi
  • 17
  • 6
  • What is the specific problem you're having when trying to implement your solution? What is preventing you from completing this? – Tim Williams Mar 24 '21 at 05:05
  • Hi Tim, I'm quite new to using VBA. So perhaps that is. I am able to find the string value I need, but I'm not exactly sure how to paste the offset values. Would using match and index be a better solution than using a find next? – Karan Saraogi Mar 24 '21 at 05:09
  • If you have some existing code then you should include it in your post, even if its not complete. Questions without code tend to get closed here. – Tim Williams Mar 24 '21 at 05:14
  • Okay thank you! Will just add my code as well! – Karan Saraogi Mar 24 '21 at 05:19
  • 1
    Here is how I would do it. **1.** I'll loop through all worksheets & use Autofilter to filter on `Employee Code` as shown [HERE](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) & copy across all rows (without doing any comparision) **2.** Once my output is ready, I'll add a helper column with formula to check if `S17<>K17` **3.** I will again use autofilter on this helper column to delete rows which are not needed. **4.** Finally I will keep the necessary columns and delete the unnecessary columns. – Siddharth Rout Mar 24 '21 at 06:13
  • 1
    *2 major benefits of above method* **1.** Avoiding multiple loops to find employee id. **2.** Avoiding multiple checkes of `S17<>K17` in a loop. – Siddharth Rout Mar 24 '21 at 06:16
  • If you would kindly clarify: you are searching in the whole used range yet you are using offset which indicates that you are expecting the found values in one column only. If this column is column `B`, then `offset(, 9)` means column `K` (is ok), and `offset(, 23)` means column `Y` yet you talk about column `S`. `i = 5` yet you talk about `A4` and `B4`. `i = i + 3` would indicate that you want to paste the results every third row which you haven't mentioned. If `Sheets("Result2")` is in the same workbook, attach a leading `Thisworkbook.` to it. Also, you should exclude it from the search. – VBasic2008 Mar 24 '21 at 06:51
  • Hi Siddharth, I checked the solution you provided and it would be slightly difficult for me to implement since I also need data from below the found value. i.e. 3 and 4 rows below it. If i used the filter, it would remove all that information. – Karan Saraogi Mar 24 '21 at 07:04
  • Hi Vbasic2008, Thank you for all these issues. I have clarified and added more details based on your comment. I do expect my results only in Column B of every sheet, and will include that in the find as well. Secondly, I have changed my post to say that I want results from K and Y(not K and S) as earlier. Furthermore, I would like my results to start at A5 and B5, with the range results(from 3 rows below the found value in C5:AN5) and 4 rows below the found value in C6:AN6). Lastly, I will include the Thisworkbook and Exclude it from the search. – Karan Saraogi Mar 24 '21 at 07:06
  • Let's say your first found employee code is in `B10`. What exactly would you like to do (use exact range references e.g. `D13:AN14` to `C5:AM6`...)? What will you copy and which row stays empty? – VBasic2008 Mar 24 '21 at 07:14
  • If Employee Code is in B10, Cell K10 would be copied into Result2 A5, Cell Y10 would be in Result2 B5, Range(D13:AM14) to Result2 (C5:AL6) – Karan Saraogi Mar 24 '21 at 07:38

1 Answers1

0

With FindNext check the search hasn't started again from the beginning.

Sub FandAndExecute2()

    Const TEXT = "Employee Code:-"
    Const COL_CODE = 2 ' B
    Const COL_Y = 25 ' Y
    Const COL_K = 11 ' K
    ' copy from
    Const COL_START = "D"
    Const COL_END = "AM"
    ' copy to
    Const TARGET = "Result2"
    Const START_ROW = 5
    
    Dim wb As Workbook, ws As Worksheet, wsResult As Worksheet
    Dim rng As Range, rngSearch As Range, rngCopy As Range
    Dim r As Long, iLastRow As Long, iTarget As Long
    Dim sFirstFind As String, K, Y, n As Integer
    
    Set wb = ThisWorkbook
    Set wsResult = wb.Sheets(TARGET)
    iTarget = START_ROW
    
    ' scan sheets
    For Each ws In wb.Sheets
        If ws.Name = TARGET Then GoTo skip

        iLastRow = ws.Cells(Rows.Count, COL_CODE).End(xlUp).Row
        Set rngSearch = ws.Cells(1, COL_CODE).Resize(iLastRow)
        
        ' search for text
        With rngSearch
        Set rng = .Find(TEXT, LookIn:=xlValues)
        If Not rng Is Nothing Then
            sFirstFind = rng.Address
            Do
                r = rng.Row
                K = ws.Cells(r, COL_K)
                Y = ws.Cells(r, COL_Y)
                If K <> Y Then
                    ' copy block
                    wsResult.Cells(iTarget, "A").Value = K
                    wsResult.Cells(iTarget, "B").Value = Y
                    Set rngCopy = ws.Range(COL_START & r + 3 & ":" & COL_END & r + 4)
                    rngCopy.Copy wsResult.Cells(iTarget, "C")
                    iTarget = iTarget + 3
                    n = n + 1
                End If
                Set rng = .FindNext(rng) ' find next
             Loop While Not rng Is Nothing And rng.Address <> sFirstFind

        End If
        End With
skip:
    Next
    MsgBox n & " blocks copied to " & wsResult.Name, vbInformation
End Sub
CDP1802
  • 13,871
  • 2
  • 7
  • 17