excelvbauniquerepeatis-empty

Getting a pair of numbers sent from one excel sheet to another sheet with gaps in between

For starters, I have data that "usually" comes into 2 rows into excel. I need the (Case #) and (Item #). The problem being is that my (Case #) is on let's say A2 and my (Item #) is on A3 they don't match up perfectly. I also get some (Case #) that have multiple (Item #) which would need to be extracted as well.

I have currently had my VBA code to pull my (Case #) put it does not move down 2 cells for the other (Case #).

Sub CopyAndPrintData()
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    
    ' Set the source and destination sheets
    Set sourceSheet = ThisWorkbook.Sheets("DATA") sheet

    Set destSheet = ThisWorkbook.Sheets("LOTTAG") 

    ' Find the last row with data in the source sheet
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For currentRow = 2 To lastRow ' Assuming your data starts from row 2, change as needed
        ' Copy data from source sheet to destination sheet
        sourceSheet.Rows(currentRow).Copy destSheet.Rows(currentRow)
        
        ' Print the destination sheet
        destSheet.PrintOut
        
        'Pause for a moment 
        Application.Wait Now + TimeValue("00:00:02") ' Wait for 2 seconds
        
        ' Clear contents of the destination sheet for the next iteration
        destSheet.Rows(currentRow).ClearContents
    Next currentRow
End Sub

This is a bit of my code. Here is some Sample data. The data in the middle doesn't matter but does need to be there. Data on the left most column is (Case #) and right most is (Item #)

1

Solution 
  • Option Explicit
Sub CopyAndPrintData()
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastRowS As Long, lastRowD As Long
    Dim endRow As Long, lastRow As Long
    Dim currentRow As Long, i As Long
    ' Set the source and destination sheets
    Set sourceSheet = ThisWorkbook.Sheets("DATA")
    Set destSheet = ThisWorkbook.Sheets("LOTTAG")
    ' Find the last row with data in the source sheet
    With sourceSheet
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            lastRow = 1
        Else
            lastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
            Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
        End If
        lastRowS = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    lastRowD = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
    If lastRowD > 1 Then
        destSheet.Rows("2:" & lastRowD).ClearContents
    End If
    ' Loop through each row in the source sheet
    With sourceSheet
        For currentRow = 2 To lastRowS ' Assuming your data starts from row 2, change as needed
            endRow = 0
            For i = currentRow + 1 To lastRow
                If Len(.Cells(i, 1).Value) > 0 Then
                    endRow = i
                    Exit For
                End If
            Next i
            If endRow = 0 Then endRow = lastRow + 1
            ' Copy data from source sheet to destination sheet
            .Cells(currentRow, 1).Resize(endRow - currentRow).EntireRow.Copy destSheet.Cells(2, 1)
            ' Print the destination sheet
             destSheet.PrintOut
            'Pause for a moment
             Application.Wait Now + TimeValue("00:00:02") ' Wait for 2 seconds
            ' Clear contents of the destination sheet for the next iteration
            destSheet.UsedRange.Offset(1).ClearContents
            currentRow = endRow - 1
        Next currentRow
    End With
End Sub