How to capture row addresses?

[trillium]

Hi

I have a dataset whereby I need to look through it to find a pre-defined search value. Once found, I have code to copy the entire row and paste it onto another sheet. For this, I am fine.

What I would like to do is add a functionality that will record on the other sheet, the row addresses from where they originated.

For example:
Dataset
Row Value
1 100
2 100
3 101
4 101
5 101
6 102
7 102

Search value = 101

I want to know they are found in rows 3 to 5

I was trying to modify this code (see below) but without success....

http://siddharthrout.wordpress.com/2...-in-excel-vba/

Any suggestions?

[mike7952]

I have a dataset whereby I need to look through it to find a pre-defined search value. Once found, I have code to copy the entire row and paste it onto another sheet

Whats your code. The same line that is copying the data to the new sheet you can copy the row number to another sheet.

[trillium]

Hi there, yes I know it's in there, I just can't seem to figure out how to pull it out...

warning: it's quite long!

Sub RollUp()

  Dim wsSource                  As Worksheet
  Dim wsDest                    As Worksheet
  Dim wsDestBU                  As Worksheet  'BU back-up
  Dim wbSource                  As Workbook
  Dim wbDest                    As Workbook
  Dim iIdx                      As Integer
  Dim sAuditNum                 As String 
  Dim sMessage                  As String
  Dim lIdx                      As Long 
  Dim lBUCount                  As Long
  Dim lCopyCount                As Long

'''I've cut out the code that finds and sets the Source and Dest ws/wb'''

  lCopyCount = 0:  lBUCount = 0 
  sAuditNum = wbSource.Sheets("Quality Review Input Sheet").Range("C5").Value & "" 'set string version (could have letters) and in excel it guesses the formating/format to text or numeric, so we will set our formatting ourselves
  'take the value(c5) and concantenate the value(number/letter) will make sure it sets it as a string for sure!! makes sure we are looking for text versions of those characters
  
  
  ' calculate movement quantities and prompt for confirm before actually doing anything - it will calc # of things it will move from DestSheet to DestBU and calc # of rows in "N" with a 1. askes us to verify what we are moving over.

    ' count destination records to move
    For lIdx = wsDest.Cells(25000, 1).End(xlUp).Row To 2 Step -1 'row2 is beginnig of data, row 1 is header. 
      If (wsDest.Cells(lIdx, 1).Value & "" = sAuditNum & "") Then lBUCount = lBUCount + 1 
    Next lIdx '&"" to be sure its a text and balance it out on sAduit to be sure they are both text.
    ' count rows in Source that have value of 1 in column N (column 14)
    For lIdx = wsSource.Cells(500, 1).End(xlUp).Row To 2 Step -1
      If Not (IsError(wsSource.Cells(lIdx, 14).Value)) Then 
        If (wsSource.Cells(lIdx, 14).Value = 1) Then lCopyCount = lCopyCount + 1
      End If
    Next lIdx
    
    If lBUCount >= 1 Then
    sMessage = "Audit Number : " & sAuditNum & vbCr & vbCr & _
               "Note: " & lBUCount & " existing records were found.  They will be moved to the Back Up tab." & vbCr & _
               lCopyCount & " records will be copied" & _
               vbCr & vbCr & "Continue?"
    ' exit if user selected NO, otherwise continue
    If MsgBox(sMessage, vbQuestion + vbYesNo, "") = vbNo Then Exit Sub
    End If
    
  lCopyCount = 0:  lBUCount = 0
  
  ' move any records in the destination matching the AuditNumber to the followup archive
  For lIdx = wsDest.Cells(25000, 1).End(xlUp).Row To 2 Step -1
    If (wsDest.Cells(lIdx, 1).Value & "" = sAuditNum & "") Then
      wsDest.Cells(lIdx, 1).EntireRow.Cut wsDestBU.Cells(wsDestBU.Cells(25000, 1).End(xlUp).Row + 1, 1) 
      wsDest.Cells(lIdx, 1).EntireRow.Delete Shift:=xlUp 
      lBUCount = lBUCount + 1 
    End If
  Next lIdx

  ' copy rows in Source that have value of 1 in column N (column 14)
  For lIdx = wsSource.Cells(500, 1).End(xlUp).Row To 2 Step -1
    If Not (IsError(wsSource.Cells(lIdx, 14).Value)) Then
      If (wsSource.Cells(lIdx, 14).Value = 1) Then
        wsSource.Cells(lIdx, 1).EntireRow.Copy
        wsDest.Cells(wsDest.Cells(25000, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues
        lCopyCount = lCopyCount + 1 'tally to check when I do a copy to test to see how much stuff was moved, used for later
      End If
    End If
  Next lIdx

  ' error message if no transfers
  If lCopyCount = 0 Then
    MsgBox "There was no data to copy. Check column N " & vbCr & _
           "to make sure there are scores.", vbExclamation, "No Data Copied"
    Exit Sub
  End If

CleanUp:
  Set wsSource = Nothing:       Set wbSource = Nothing   ': means you have 2 lines of code on one row
  Set wsDest = Nothing:         Set wbDest = Nothing
  Set wsDestBU = Nothing


End Sub

I am already counting the rows, and the data stays together when it is copied... but I wanted to know where on the ws.Source tab the data was coming from before it's being copied to the Archive tab. I was going to populate the row addresses (i.e. Rows(3:15)) in a column on the Archive tab, I was thinking in the first row of data for each audit #.

Any advise/direction would be greatly appreciated!

[xladept]

Hi trillium,

If you're copying the entire row, you must already know which row it is????

[trillium]

Hi xladept,

Yes I do.. but not sure how to pass it onto another sheet. I've posted the code under the last comment. Thanks!

[mike7952]

See if this helps

  ' copy rows in Source that have value of 1 in column N (column 14)
  For lIdx = wsSource.Cells(500, 1).End(xlUp).Row To 2 Step -1
    If Not (IsError(wsSource.Cells(lIdx, 14).Value)) Then
      If (wsSource.Cells(lIdx, 14).Value = 1) Then
        wsSource.Cells(lIdx, 1).EntireRow.Copy
        Debug.Print wsSource.Cells(lIdx, 1).Row ''''''This should get you the row number'''''''''
        wsDest.Cells(wsDest.Cells(25000, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues
        lCopyCount = lCopyCount + 1 'tally to check when I do a copy to test to see how much stuff was moved, used for later
      End If
    End If
  Next lIdx

[xladept]

Hi trillium,

It looks to be the lIdx value. So, just record the lIdx value after you do the PasteSpecial:

Cells(r,c)=Cells(r,c) & ", " & lIdx

or something like it. (like mike's post)

[trillium]

hmmm my reply didn't show up!

Thank you so much for the help! I moved that line of code Mike7952 to the ws.Dest section as that's where the rows were I wanted to know about. However, is there a way to place the infomation onto another tab instead of in the Immediate window?

I want to know which row was the starting one and which was the ending one... like the Min and Max of the selection...

I wonder... If I can caputre that first row it selects, which is actually the last row, and subtract from the BUcount I've already done, I'll get the first row... and past that into the Archive tab then.... wheels are turning.....

[mike7952]

Mabe you can adopt this into your code

Sub abc()
 Dim aMinMax
 
 ReDim aMinMax(0)
 For i = 1 To 10
    aMinMax(UBound(aMinMax)) = WorksheetFunction.RandBetween(1, 1000)
    Debug.Print aMinMax(UBound(aMinMax))
    ReDim Preserve aMinMax(UBound(aMinMax) + 1)
 Next
 Debug.Print "Min value was: " & WorksheetFunction.Min(aMinMax)
 Debug.Print "Max value was: " & WorksheetFunction.Max(aMinMax)
End Sub

[trillium]

Hi Mike7952

I'm not quite sure how to intergrate that idea into the code...
I was thinking... since your first idea pulls out ALL the rows... how can we manilpulate it to just pull out the FIRST row it finds... when I tested it, the row it pulled out first was actually the last row (it was 1666 in my real dataset) becauase it was looping through End(xlUp). How do we get it to STOP as soon as it finds a match, even if there are more afterwards?

Would the FIND function work? Can we make it go end up?

[trillium]

I did it!!

I used the FIND function!

Thank you for all your help!

Dim LastRow As Range 'to capture address of placement on tracker tab before it's copied to BU tab
Dim strCriteria As Long 'search address on audit #

strCriteria = wbSource.Sheets("Quality Review Input Sheet").Range("C5").Value

With wbDest.Sheets("QR Tracker Pivot Renewal")
Set LastRow = .Cells.Find(What:=strCriteria, _
After:=.Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With

'If LastRow Is Nothing Then MsgBox "No match"
If Not LastRow Is Nothing Then

    wsSource.Range("AP2").Value = LastRow.Row
    wsSource.Range("AQ2").Value = LastRow.Row + lBUCount

 End If

[xladept]

Way to go - glad for you!