VBA - Finding ID# within 2 sheets and posting in separate workbook

Question

I am utilizing a double loop that searches to find matching ID #s in corresponding sheets. All of the variables are defined properly, but for some reason only 4 names copy over to the separate workbook, I know that there are more than that. There are over 1000 numbers in each sheet, I am not sure if it has something to do with that.

The logic behind my code is that the first loop stays put until it finds the matching number in the other sheet, then if it does, it will exit the second loop and start the next number in the first loop and start over in the second loop.

CODE:

Dim tw As ThisWorkbook: Set tw = ThisWorkbook
Dim s1 As Excel.Worksheet: Set s1 = tw.Worksheets(2)
Dim rwCnt1 As Integer: rwCnt1 = s1.Range("A1", s1.Range("A1").End(xlDown)).Rows.Count
Dim nav As Excel.Worksheet: Set nav = tw.Worksheets("Navigator")
Dim rwCnt2 As Integer: rwCnt2 = nav.Range("A1", nav.Range("A1").End(xlDown)).Rows.Count
Dim x As Integer, y As Integer, z As Integer

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim tempWB As Workbook
Dim tempWS As Worksheet
Dim i As Integer

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True

FileChosen = fd.Show
If FileChosen = -1 Then

    s1.Columns(16).NumberFormat = "@"
    s1.Range("A3:Z" & rwCnt1).Sort key1:=s1.Range("P1"), order1:=xlAscending, Header:=xlYes

    For i = 1 To fd.SelectedItems.Count

        Set tempWB = Workbooks.Open(fd.SelectedItems(i))
        Set tempWS = tempWB.Worksheets(1)
        tempWS.Columns(4).NumberFormat = "@"

        tempWB.Unprotect

        z = 1

        For y = 4 To rwCnt1
            For x = 3 To rwCnt2
                If nav.Cells(x, 5).Value2 = s1.Cells(y, 16).Value2 Then
                    z = z + 1
                    With nav
                        tempWS.Cells(z, 1) = .Cells(x, 2).Value2
                        tempWS.Cells(z, 2) = .Cells(x, 3).Value2
                        tempWS.Cells(z, 3) = .Cells(x, 4).Value2
                        tempWS.Cells(z, 4) = .Cells(x, 5).Value2
                        tempWS.Cells(z, 7) = .Cells(x, 6).Value2
                        tempWS.Cells(z, 10) = .Cells(x, 7).Value2
                        tempWS.Cells(z, 11) = .Cells(x, 8).Value2
                        tempWS.Cells(z, 12) = .Cells(x, 9).Value2
                    End With
                    Exit For
                End If 
            Next x
        Next y

    Next i
End If

I just don't understand why there are only 4 that transfer over. If anyone has a better solution than I have, please let me know. I attempted to use If Not "Variable" Is Nothing Then, but I couldn't figure how to apply it. Thanks in advance!

Are there blank rows in your columns? Try changing rwCnt1 to `s1.Cells(Rows.Count, 1).End(xlUp).Row` Do the same with rwCnt2 — The Dude, Jun 16 '18 at 10:16
Also, don't use `Integer` for row counting, Excel has more rows than `Integer` can handle. It is recommended to always use Long instead of Integer. https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long/26409520#26409520 — The Dude, Jun 16 '18 at 10:27
@The Dude - I will add these changes on Monday and let you know what it does — A Cohen, Jun 16 '18 at 12:16
@TheDude - I made your recommended adjustments and it doesn't seem to have solved the issue. — A Cohen, Jun 18 '18 at 13:31

score 0 · Accepted Answer · answered Jun 18 '18 at 16:14

The issue was that the number format couldn't read each other properly.

Therefore I added two short lines to change the number format. and call them from my original code.

CODE:

Private Sub reformat_nav_col5()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Navigator")
Dim c As Range

ws.Activate
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
For Each c In Selection
    c = c * 1  ' convert "number stored as text" to number
Next c
Selection.NumberFormat = "000000000" '"@"

Range("E3").Select

End Sub
'----------------------------------------------------
Sub reformat_visa_col16()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Visa")
Dim c As Range

ws.Activate
Range("P4").Select
Range(Selection, Selection.End(xlDown)).Select
For Each c In Selection
    c = c * 1  ' convert "number stored as text" to number
Next c
Selection.NumberFormat = "000000000" '"@"

Range("P4").Select

End Sub

VBA - Finding ID# within 2 sheets and posting in separate workbook

1 Answers1