I am trying to improve the workbook macro from my previous thread. I need to do the following:

1. Limit the search within a range of the worksheet (ex. Sheet 1 B1:N:200)
2. Search the 8th column (I) of the limit range Sheet1 for keyword ("Goods")
3. Copy the data found in the 9th column (J) of same row where instance ("Goods") is found
4. Paste Value of Sheet 1 - column 9 to Sheet2 - Column 7
5. Search Again 8th column (I) of the limit range Sheet1 for keyword ("Services")
6. Copy the data found in the 9th column (J) of same row where instance ("Services") is found
7. Paste Value of Sheet 1 - column 9 to Sheet2 - Column 8

I am trying to self study to understand how the code works and integrate it with code provided by @CDP1802 in previous thread but I can't get how to split result position for the goods and services matches.

Here is the working code provided by @CDP1802 in my previous thread.

    Option Explicit
    Sub CopyCells()
    
        Const ROW_START = 3
    
        Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
        Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
        Dim keywords, word, t0 As Single: t0 = Timer
        keywords = Array("Goods", "Services")
        
        Set wb = ThisWorkbook
        Set ws1 = wb.Sheets(1)
        Set ws2 = wb.Sheets(2)
        lastrow2 = ROW_START
        
        Application.ScreenUpdating = False
        With ws1
            lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
            For Each word In keywords
                For r = 1 To lastrow1
                    If Len(.Cells(r, "I")) = 0 Then
                        Exit For
                    ElseIf .Cells(r, "I") = word Then
                        'Sht1 col 2 to Sht2 Col 3 (no format values only)
                        'Sht1 col 5 to Sht2 Col 4 (with format and values)
                        ws2.Cells(lastrow2, "C") = .Cells(r, "B")
                        ws2.Cells(lastrow2, "D") = .Cells(r, "E")
                        .Cells(r, "E").Copy
                        ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
                        lastrow2 = lastrow2   1
                        n = n   1
                    End If
                Next
            Next
        End With
        Application.ScreenUpdating = True
        
        MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
        vbInformation, Format(Timer - t0, "0.0 secs")
    End Sub

Here is the code i made to try to do what i need, however I am stump how to use the previous position counter's value for the next argument for "Services" so it follow the next row after the Goods results are done. Current code starts the services result to position 1 again.

in summary I am Looking for a code to integrate desired results in 1 macro for efficiency.

   Sub test1code()
   
   Dim lngLastRowSht1 As Long
   Dim lngLastRowSht2 As Long
   Dim counterSht1 As Long
   Dim counterSht2 As Long
   Dim resultrow As Long
   Const ROW_START = 4
       'for Goods data
   With Worksheets(1)
       resultrow = 1
       lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
       lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
           For counterSht1 = 1 To lngLastRowSht1   1
                       If Len(Sheets(1).Range("H" & (counterSht1))) = 0 Then
                       Exit For
                   ElseIf Sheets(1).Range("H" & (counterSht1)) = "Goods" Then
                        Sheets(2).Range("F" & (resultrow)).Value = Sheets(1).Range("I" & counterSht1).Value
                           resultrow = resultrow   1
                                              
                              End If
                             Next counterSht1
           
              
                
   End With
   
   'for Services data
   With Worksheets(1)
       resultrow = 1
       lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
       lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
           For counterSht1 = 1 To lngLastRowSht1   1
                       If Len(Sheets(1).Range("H" & (counterSht1))) = 0 Then
                       Exit For
                   ElseIf Sheets(1).Range("H" & (counterSht1)) = "Services" Then
                        Sheets(2).Range("G" & (resultrow)).Value = Sheets(1).Range("I" & counterSht1).Value
                           resultrow = resultrow   1
                                    End If
                Next counterSht1
   End With
   End Sub

CodePudding user response：

Removing resultrow = 1 in the service block of codes so that it will retain the previous row number after looping through for "Goods".

Assuming that the above fix the issue, below is how you can merge both processes into a single block (also removed lngLastRowSht2 as it's not been used and standardize the use of Worksheets and Sheets):

Sub test1code()
   
   Dim lngLastRowSht1 As Long
   Dim counterSht1 As Long
   Dim counterSht2 As Long
   Dim resultrow As Long
   Const ROW_START = 4
       
   With Worksheets(1)
        resultrow = 1
        lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
        
        'for Goods data
        For counterSht1 = 1 To lngLastRowSht1   1
            If Len(Worksheets(1).Range("H" & counterSht1)) = 0 Then
                Exit For
            ElseIf Worksheets(1).Range("H" & counterSht1) = "Goods" Then
                Worksheets(2).Range("F" & resultrow).Value = Worksheets(1).Range("I" & counterSht1).Value
                resultrow = resultrow   1
            End If
        Next counterSht1
   
        'for Services data
        For counterSht1 = 1 To lngLastRowSht1   1
            If Len(Worksheets(1).Range("H" & counterSht1)) = 0 Then
                Exit For
            ElseIf Worksheets(1).Range("H" & counterSht1) = "Services" Then
                Worksheets(2).Range("G" & resultrow).Value = Worksheets(1).Range("I" & counterSht1).Value
                resultrow = resultrow   1
            End If
        Next counterSht1
   End With
End Sub