Data not pulling from secondary workbook

D

DanSMT

Board Regular
Joined
Sep 13, 2019
Messages
203
Office Version
  1. 2013
Platform
  1. Windows
Hey all,

Im trying to pull data from a secondary workbook based on the information entered into an array of textboxes on a userform. Everything else appears to be working except when trying to pull the information over from the secondary workbook. Any ideas?

VBA Code: 
Private Sub testcb_Click()

Dim i2 As Long
For i2 = 1 To 20
If Me.Controls("RITB" & i2).Text = vbNullString Then
Else
Worksheets("fai").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Me.Controls("RITB" & i2).Text & " FAI"
ActiveSheet.Range("c4").Value = Me.Controls("RITB" & i2).Text
Dim source, target As Worksheet
Set target = Workbooks("New RI Form rev9 - Develop Mode - DO NOT USE.xlsb").Sheets("RI Log")

targetlastrow = target.Range("B" & target.Rows.Count).End(xlUp).Row

    For j = 2 To targetlastrow
        If target.Range("B" & j).Value = ActiveSheet.Range("c4").Value Then

        ActiveSheet.Range("A9").Value = "A"
        ActiveSheet.Range("B9").Value = target.Cells(rng.Row, 90).Value
        ActiveSheet.Range("C9").Value = target.Cells(rng.Row, 91).Value
        ActiveSheet.Range("D9").Value = target.Cells(rng.Row, 89).Value

        End If
    Next j

End If
Next

End Sub
 
Sort by date Sort by votes
I removed 5 of the 15 lines and it worked correctly. It appears if there are more then 10 lines the code doesn't like it. Is that due to not have an exit or something once the last column is full?
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Posting code for reference. Sorry its pretty lengthy.

VBA Code: 
Private Sub testcb_Click()

Workbooks("PPAP Template.xlsm").Activate

Dim i2 As Long
For i2 = 1 To 20
If Me.Controls("RITB" & i2).Text = vbNullString Then
Else
Worksheets("fai").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Me.Controls("RITB" & i2).Text & " FAI"
ActiveSheet.Range("c4").Value = Me.Controls("RITB" & i2).Text


Dim target As Workbook
Set target = Workbooks("New RI Form rev9 - Develop Mode - DO NOT USE.xlsb")

Dim targetsheet As Worksheet
Set targetsheet = target.Sheets("RI Log")

targetlastrow = targetsheet.Range("B" & targetsheet.Rows.Count).End(xlUp).Row

    For j = targetlastrow To 2 Step -1
    'For j = 2 To targetlastrow
        If targetsheet.Range("B" & j).Value = ActiveSheet.Range("c4").Value Then
        
            'A
            If ActiveSheet.Range("A9").Value = "" Then
                ActiveSheet.Range("A9").Value = "A"
                ActiveSheet.Range("B9").Value = targetsheet.Cells(j, 90).Value
                ActiveSheet.Range("C9").Value = targetsheet.Cells(j, 91).Value
                ActiveSheet.Range("D9").Value = targetsheet.Cells(j, 89).Value
            End If
''Loop through columns F:O to find first blank cell in that range of row 9
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(9, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(9, EmptyColumnCell).Value = targetsheet.Cells(j, 26).Value

            'B
            If ActiveSheet.Range("A10").Value = "" Then
                ActiveSheet.Range("A10").Value = "B"
                ActiveSheet.Range("B10").Value = targetsheet.Cells(j, 93).Value
                ActiveSheet.Range("C10").Value = targetsheet.Cells(j, 94).Value
                ActiveSheet.Range("D10").Value = targetsheet.Cells(j, 92).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(10, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(10, EmptyColumnCell).Value = targetsheet.Cells(j, 27).Value

            'C
            If ActiveSheet.Range("A11").Value = "" Then
                ActiveSheet.Range("A11").Value = "C"
                ActiveSheet.Range("B11").Value = targetsheet.Cells(j, 96).Value
                ActiveSheet.Range("C11").Value = targetsheet.Cells(j, 97).Value
                ActiveSheet.Range("D11").Value = targetsheet.Cells(j, 95).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(11, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(11, EmptyColumnCell).Value = targetsheet.Cells(j, 28).Value
            
            'D
            If ActiveSheet.Range("A12").Value = "" Then
                ActiveSheet.Range("A12").Value = "D"
                ActiveSheet.Range("B12").Value = targetsheet.Cells(j, 99).Value
                ActiveSheet.Range("C12").Value = targetsheet.Cells(j, 100).Value
                ActiveSheet.Range("D12").Value = targetsheet.Cells(j, 98).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(12, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(12, EmptyColumnCell).Value = targetsheet.Cells(j, 29).Value
        
            'E
            If ActiveSheet.Range("A13").Value = "" Then
                ActiveSheet.Range("A13").Value = "E"
                ActiveSheet.Range("B13").Value = targetsheet.Cells(j, 102).Value
                ActiveSheet.Range("C13").Value = targetsheet.Cells(j, 103).Value
                ActiveSheet.Range("D13").Value = targetsheet.Cells(j, 101).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(13, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(13, EmptyColumnCell).Value = targetsheet.Cells(j, 30).Value
            
            'F
            If ActiveSheet.Range("A14").Value = "" Then
                ActiveSheet.Range("A14").Value = "F"
                ActiveSheet.Range("B14").Value = targetsheet.Cells(j, 105).Value
                ActiveSheet.Range("C14").Value = targetsheet.Cells(j, 106).Value
                ActiveSheet.Range("D14").Value = targetsheet.Cells(j, 104).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(14, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(14, EmptyColumnCell).Value = targetsheet.Cells(j, 31).Value
            
            'G
            If ActiveSheet.Range("A15").Value = "" Then
                ActiveSheet.Range("A15").Value = "G"
                ActiveSheet.Range("B15").Value = targetsheet.Cells(j, 108).Value
                ActiveSheet.Range("C15").Value = targetsheet.Cells(j, 109).Value
                ActiveSheet.Range("D15").Value = targetsheet.Cells(j, 107).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(15, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(15, EmptyColumnCell).Value = targetsheet.Cells(j, 32).Value
            
            'H
            If ActiveSheet.Range("A16").Value = "" Then
                ActiveSheet.Range("A16").Value = "H"
                ActiveSheet.Range("B16").Value = targetsheet.Cells(j, 111).Value
                ActiveSheet.Range("C16").Value = targetsheet.Cells(j, 112).Value
                ActiveSheet.Range("D16").Value = targetsheet.Cells(j, 110).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(16, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(16, EmptyColumnCell).Value = targetsheet.Cells(j, 33).Value
            
            'I
            If ActiveSheet.Range("A17").Value = "" Then
                ActiveSheet.Range("A17").Value = "I"
                ActiveSheet.Range("B17").Value = targetsheet.Cells(j, 114).Value
                ActiveSheet.Range("C17").Value = targetsheet.Cells(j, 115).Value
                ActiveSheet.Range("D17").Value = targetsheet.Cells(j, 113).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(17, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(17, EmptyColumnCell).Value = targetsheet.Cells(j, 34).Value
            
            'J
            If ActiveSheet.Range("A18").Value = "" Then
                ActiveSheet.Range("A18").Value = "J"
                ActiveSheet.Range("B18").Value = targetsheet.Cells(j, 117).Value
                ActiveSheet.Range("C18").Value = targetsheet.Cells(j, 118).Value
                ActiveSheet.Range("D18").Value = targetsheet.Cells(j, 116).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(18, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(18, EmptyColumnCell).Value = targetsheet.Cells(j, 35).Value
            
            'K
            If ActiveSheet.Range("A19").Value = "" Then
                ActiveSheet.Range("A19").Value = "K"
                ActiveSheet.Range("B19").Value = targetsheet.Cells(j, 120).Value
                ActiveSheet.Range("C19").Value = targetsheet.Cells(j, 121).Value
                ActiveSheet.Range("D19").Value = targetsheet.Cells(j, 119).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(19, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(19, EmptyColumnCell).Value = targetsheet.Cells(j, 36).Value
            
            'L
            If ActiveSheet.Range("A20").Value = "" Then
                ActiveSheet.Range("A20").Value = "L"
                ActiveSheet.Range("B20").Value = targetsheet.Cells(j, 123).Value
                ActiveSheet.Range("C20").Value = targetsheet.Cells(j, 124).Value
                ActiveSheet.Range("D20").Value = targetsheet.Cells(j, 122).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(20, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(20, EmptyColumnCell).Value = targetsheet.Cells(j, 37).Value
            
            'M
            If ActiveSheet.Range("A21").Value = "" Then
                ActiveSheet.Range("A21").Value = "M"
                ActiveSheet.Range("B21").Value = targetsheet.Cells(j, 126).Value
                ActiveSheet.Range("C21").Value = targetsheet.Cells(j, 127).Value
                ActiveSheet.Range("D21").Value = targetsheet.Cells(j, 125).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(21, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(21, EmptyColumnCell).Value = targetsheet.Cells(j, 38).Value
            
            'N
            If ActiveSheet.Range("A22").Value = "" Then
                ActiveSheet.Range("A22").Value = "N"
                ActiveSheet.Range("B22").Value = targetsheet.Cells(j, 129).Value
                ActiveSheet.Range("C22").Value = targetsheet.Cells(j, 130).Value
                ActiveSheet.Range("D22").Value = targetsheet.Cells(j, 128).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(22, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(22, EmptyColumnCell).Value = targetsheet.Cells(j, 39).Value
            
            'O
            If ActiveSheet.Range("A23").Value = "" Then
                ActiveSheet.Range("A23").Value = "O"
                ActiveSheet.Range("B23").Value = targetsheet.Cells(j, 132).Value
                ActiveSheet.Range("C23").Value = targetsheet.Cells(j, 133).Value
                ActiveSheet.Range("D23").Value = targetsheet.Cells(j, 131).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(23, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(23, EmptyColumnCell).Value = targetsheet.Cells(j, 40).Value
            
            'P
            If ActiveSheet.Range("A24").Value = "" Then
                ActiveSheet.Range("A24").Value = "P"
                ActiveSheet.Range("B24").Value = targetsheet.Cells(j, 135).Value
                ActiveSheet.Range("C24").Value = targetsheet.Cells(j, 136).Value
                ActiveSheet.Range("D24").Value = targetsheet.Cells(j, 134).Value
            End If
''Loop through columns F:O to find first blank cell in that range of row 9
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(24, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(24, EmptyColumnCell).Value = targetsheet.Cells(j, 41).Value

            'Q
            If ActiveSheet.Range("A25").Value = "" Then
                ActiveSheet.Range("A25").Value = "Q"
                ActiveSheet.Range("B25").Value = targetsheet.Cells(j, 138).Value
                ActiveSheet.Range("C25").Value = targetsheet.Cells(j, 139).Value
                ActiveSheet.Range("D25").Value = targetsheet.Cells(j, 137).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(25, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(25, EmptyColumnCell).Value = targetsheet.Cells(j, 42).Value

            'R
            If ActiveSheet.Range("A26").Value = "" Then
                ActiveSheet.Range("A26").Value = "R"
                ActiveSheet.Range("B26").Value = targetsheet.Cells(j, 141).Value
                ActiveSheet.Range("C26").Value = targetsheet.Cells(j, 142).Value
                ActiveSheet.Range("D26").Value = targetsheet.Cells(j, 140).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(26, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(26, EmptyColumnCell).Value = targetsheet.Cells(j, 43).Value
            
            'S
            If ActiveSheet.Range("A27").Value = "" Then
                ActiveSheet.Range("A27").Value = "S"
                ActiveSheet.Range("B27").Value = targetsheet.Cells(j, 144).Value
                ActiveSheet.Range("C27").Value = targetsheet.Cells(j, 145).Value
                ActiveSheet.Range("D27").Value = targetsheet.Cells(j, 143).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(27, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(27, EmptyColumnCell).Value = targetsheet.Cells(j, 44).Value
        
            'T
            If ActiveSheet.Range("A28").Value = "" Then
                ActiveSheet.Range("A28").Value = "T"
                ActiveSheet.Range("B28").Value = targetsheet.Cells(j, 147).Value
                ActiveSheet.Range("C28").Value = targetsheet.Cells(j, 148).Value
                ActiveSheet.Range("D28").Value = targetsheet.Cells(j, 146).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(28, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(28, EmptyColumnCell).Value = targetsheet.Cells(j, 45).Value
            
            'U
            If ActiveSheet.Range("A29").Value = "" Then
                ActiveSheet.Range("A29").Value = "U"
                ActiveSheet.Range("B29").Value = targetsheet.Cells(j, 150).Value
                ActiveSheet.Range("C29").Value = targetsheet.Cells(j, 151).Value
                ActiveSheet.Range("D29").Value = targetsheet.Cells(j, 149).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(29, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(29, EmptyColumnCell).Value = targetsheet.Cells(j, 46).Value
            
            'V
            If ActiveSheet.Range("A30").Value = "" Then
                ActiveSheet.Range("A30").Value = "V"
                ActiveSheet.Range("B30").Value = targetsheet.Cells(j, 153).Value
                ActiveSheet.Range("C30").Value = targetsheet.Cells(j, 154).Value
                ActiveSheet.Range("D30").Value = targetsheet.Cells(j, 152).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(30, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(30, EmptyColumnCell).Value = targetsheet.Cells(j, 47).Value
            
            'W
            If ActiveSheet.Range("A31").Value = "" Then
                ActiveSheet.Range("A31").Value = "W"
                ActiveSheet.Range("B31").Value = targetsheet.Cells(j, 156).Value
                ActiveSheet.Range("C31").Value = targetsheet.Cells(j, 157).Value
                ActiveSheet.Range("D31").Value = targetsheet.Cells(j, 155).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(31, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(31, EmptyColumnCell).Value = targetsheet.Cells(j, 48).Value
            
            'X
            If ActiveSheet.Range("A32").Value = "" Then
                ActiveSheet.Range("A32").Value = "X"
                ActiveSheet.Range("B32").Value = targetsheet.Cells(j, 159).Value
                ActiveSheet.Range("C32").Value = targetsheet.Cells(j, 160).Value
                ActiveSheet.Range("D32").Value = targetsheet.Cells(j, 158).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(32, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(32, EmptyColumnCell).Value = targetsheet.Cells(j, 49).Value
            
            'Y
            If ActiveSheet.Range("A33").Value = "" Then
                ActiveSheet.Range("A33").Value = "Y"
                ActiveSheet.Range("B33").Value = targetsheet.Cells(j, 162).Value
                ActiveSheet.Range("C33").Value = targetsheet.Cells(j, 163).Value
                ActiveSheet.Range("D33").Value = targetsheet.Cells(j, 161).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(33, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(33, EmptyColumnCell).Value = targetsheet.Cells(j, 50).Value
            
            'Z
            If ActiveSheet.Range("A34").Value = "" Then
                ActiveSheet.Range("A34").Value = "Z"
                ActiveSheet.Range("B34").Value = targetsheet.Cells(j, 165).Value
                ActiveSheet.Range("C34").Value = targetsheet.Cells(j, 166).Value
                ActiveSheet.Range("D34").Value = targetsheet.Cells(j, 164).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(34, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(34, EmptyColumnCell).Value = targetsheet.Cells(j, 51).Value
            
            'AA
            If ActiveSheet.Range("A35").Value = "" Then
                ActiveSheet.Range("A35").Value = "AA"
                ActiveSheet.Range("B35").Value = targetsheet.Cells(j, 168).Value
                ActiveSheet.Range("C35").Value = targetsheet.Cells(j, 169).Value
                ActiveSheet.Range("D35").Value = targetsheet.Cells(j, 167).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(35, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(35, EmptyColumnCell).Value = targetsheet.Cells(j, 52).Value
            
            'AB
            If ActiveSheet.Range("A36").Value = "" Then
                ActiveSheet.Range("A36").Value = "AB"
                ActiveSheet.Range("B36").Value = targetsheet.Cells(j, 171).Value
                ActiveSheet.Range("C36").Value = targetsheet.Cells(j, 172).Value
                ActiveSheet.Range("D36").Value = targetsheet.Cells(j, 170).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(36, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(36, EmptyColumnCell).Value = targetsheet.Cells(j, 53).Value
            
            'AC
            If ActiveSheet.Range("A37").Value = "" Then
                ActiveSheet.Range("A37").Value = "AC"
                ActiveSheet.Range("B37").Value = targetsheet.Cells(j, 174).Value
                ActiveSheet.Range("C37").Value = targetsheet.Cells(j, 175).Value
                ActiveSheet.Range("D37").Value = targetsheet.Cells(j, 173).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(37, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(37, EmptyColumnCell).Value = targetsheet.Cells(j, 54).Value
            
            'AD
            If ActiveSheet.Range("A38").Value = "" Then
                ActiveSheet.Range("A38").Value = "AD"
                ActiveSheet.Range("B38").Value = targetsheet.Cells(j, 177).Value
                ActiveSheet.Range("C38").Value = targetsheet.Cells(j, 178).Value
                ActiveSheet.Range("D38").Value = targetsheet.Cells(j, 176).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(38, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(38, EmptyColumnCell).Value = targetsheet.Cells(j, 55).Value
            
            'AE
            If ActiveSheet.Range("A39").Value = "" Then
                ActiveSheet.Range("A39").Value = "AE"
                ActiveSheet.Range("B39").Value = targetsheet.Cells(j, 180).Value
                ActiveSheet.Range("C39").Value = targetsheet.Cells(j, 181).Value
                ActiveSheet.Range("D39").Value = targetsheet.Cells(j, 179).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(39, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(39, EmptyColumnCell).Value = targetsheet.Cells(j, 56).Value
            
            'AF
            If ActiveSheet.Range("A40").Value = "" Then
                ActiveSheet.Range("A40").Value = "AF"
                ActiveSheet.Range("B40").Value = targetsheet.Cells(j, 183).Value
                ActiveSheet.Range("C40").Value = targetsheet.Cells(j, 184).Value
                ActiveSheet.Range("D40").Value = targetsheet.Cells(j, 182).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(40, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(40, EmptyColumnCell).Value = targetsheet.Cells(j, 57).Value
            
            'AG
            If ActiveSheet.Range("A41").Value = "" Then
                ActiveSheet.Range("A41").Value = "AG"
                ActiveSheet.Range("B41").Value = targetsheet.Cells(j, 186).Value
                ActiveSheet.Range("C41").Value = targetsheet.Cells(j, 187).Value
                ActiveSheet.Range("D41").Value = targetsheet.Cells(j, 185).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(41, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(41, EmptyColumnCell).Value = targetsheet.Cells(j, 58).Value
            
            'AH
            If ActiveSheet.Range("A42").Value = "" Then
                ActiveSheet.Range("A42").Value = "AH"
                ActiveSheet.Range("B42").Value = targetsheet.Cells(j, 189).Value
                ActiveSheet.Range("C42").Value = targetsheet.Cells(j, 190).Value
                ActiveSheet.Range("D42").Value = targetsheet.Cells(j, 188).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(42, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(42, EmptyColumnCell).Value = targetsheet.Cells(j, 59).Value
            
            'AI
            If ActiveSheet.Range("A43").Value = "" Then
                ActiveSheet.Range("A43").Value = "AI"
                ActiveSheet.Range("B43").Value = targetsheet.Cells(j, 192).Value
                ActiveSheet.Range("C43").Value = targetsheet.Cells(j, 193).Value
                ActiveSheet.Range("D43").Value = targetsheet.Cells(j, 191).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(43, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(43, EmptyColumnCell).Value = targetsheet.Cells(j, 60).Value
            
            'AJ
            If ActiveSheet.Range("A44").Value = "" Then
                ActiveSheet.Range("A44").Value = "AJ"
                ActiveSheet.Range("B44").Value = targetsheet.Cells(j, 195).Value
                ActiveSheet.Range("C44").Value = targetsheet.Cells(j, 196).Value
                ActiveSheet.Range("D44").Value = targetsheet.Cells(j, 194).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(44, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(44, EmptyColumnCell).Value = targetsheet.Cells(j, 61).Value
            
            'AK
            If ActiveSheet.Range("A45").Value = "" Then
                ActiveSheet.Range("A45").Value = "AK"
                ActiveSheet.Range("B45").Value = targetsheet.Cells(j, 198).Value
                ActiveSheet.Range("C45").Value = targetsheet.Cells(j, 199).Value
                ActiveSheet.Range("D45").Value = targetsheet.Cells(j, 197).Value
            End If
' Loop through columns F:O to find first blank cell in that range of row 10
            For i = 6 To 15
            If LenB(WorksheetFunction.Trim(Cells(45, i))) = 0 Then
                EmptyColumnCell = i
            Exit For
            End If
            Next
            ActiveSheet.Cells(45, EmptyColumnCell).Value = targetsheet.Cells(j, 62).Value
            
        End If
    Next j

End If
Next

End Sub
 
Upvote 0
Dang!!!

Lemme give you a smaller sandwich to chew on.

VBA Code: 
Private Sub testcb_Click()
'
    Workbooks("PPAP Template.xlsm").Activate
'
    Dim i2 As Long
'
    For i2 = 1 To 20
        If Me.Controls("RITB" & i2).Text = vbNullString Then
        Else
            Worksheets("fai").Copy after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Me.Controls("RITB" & i2).Text & " FAI"
            ActiveSheet.Range("c4").Value = Me.Controls("RITB" & i2).Text
'
    Dim target As Workbook
            Set target = Workbooks("New RI Form rev9 - Develop Mode - DO NOT USE.xlsb")

    Dim targetsheet As Worksheet
            Set targetsheet = target.Sheets("RI Log")
'
            targetlastrow = targetsheet.Range("B" & targetsheet.Rows.Count).End(xlUp).Row
'
'------------------------------------------------------------------------------------------------
'
    Dim ActiveSheetColumnNumber As Long
    Dim ActiveSheetRow          As Long
    Dim TargetColumnNumber      As Long
    Dim TargetRow               As Long
'
            For j = targetlastrow To 2 Step -1
'           For j = 2 To targetlastrow
                If targetsheet.Range("B" & j).Value = ActiveSheet.Range("c4").Value Then
                    ActiveSheetColumnNumber = 1
                    ActiveSheetRow = 9
                    TargetColumnNumber = 89
                    TargetRow = 26
'
'------------------------------------------------------------------------------------------------
'
'                   A thru AK
                    For TargetColumnNumber = 89 To 197 Step 3
                        If ActiveSheet.Range("A" & ActiveSheetRow).Value = "" Then
                            ActiveSheet.Range("A" & ActiveSheetRow).Value = Split(Cells(1, ActiveSheetColumnNumber).Address, "$")(1)
                            ActiveSheet.Range("B" & ActiveSheetRow).Value = targetsheet.Cells(j, TargetColumnNumber + 1).Value
                            ActiveSheet.Range("C" & ActiveSheetRow).Value = targetsheet.Cells(j, TargetColumnNumber + 2).Value
                            ActiveSheet.Range("D" & ActiveSheetRow).Value = targetsheet.Cells(j, TargetColumnNumber).Value
                        End If
'
'                       Loop through columns F:O to find first blank cell in that range of ActiveSheetRow #
                        For i = 6 To 15
                            If LenB(WorksheetFunction.Trim(Cells(ActiveSheetRow, i))) = 0 Then
                                EmptyColumnCell = i
                                Exit For
                            End If
                        Next
'
                        ActiveSheet.Cells(ActiveSheetRow, EmptyColumnCell).Value = targetsheet.Cells(j, TargetRow).Value
'
                        ActiveSheetColumnNumber = ActiveSheetColumnNumber + 1
                        ActiveSheetRow = ActiveSheetRow + 1
                        TargetRow = TargetRow + 1
                    Next
'
'------------------------------------------------------------------------------------------------
'
                End If
            Next j
        End If
    Next
End Sub
 
Upvote 0
DanSMT said:
I removed 5 of the 15 lines and it worked correctly. It appears if there are more then 10 lines the code doesn't like it. Is that due to not have an exit or something once the last column is full?
Click to expand...

You didn't specify what you want to happen if F:0 is filled. What would you like to happen at that point?
 
Upvote 0
See if this works for you:

VBA Code: 
Private Sub testcb_Click()
'
    Workbooks("PPAP Template.xlsm").Activate
'
    Dim i2 As Long
'
    For i2 = 1 To 20
        If Me.Controls("RITB" & i2).Text = vbNullString Then
        Else
            Worksheets("fai").Copy after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Me.Controls("RITB" & i2).Text & " FAI"
            ActiveSheet.Range("c4").Value = Me.Controls("RITB" & i2).Text
'
    Dim target As Workbook
            Set target = Workbooks("New RI Form rev9 - Develop Mode - DO NOT USE.xlsb")

    Dim targetsheet As Worksheet
            Set targetsheet = target.Sheets("RI Log")
'
            targetlastrow = targetsheet.Range("B" & targetsheet.Rows.Count).End(xlUp).Row
'
'------------------------------------------------------------------------------------------------
'
    Dim ActiveSheetColumnNumber     As Long
    Dim ActiveSheetRow              As Long
    Dim SecondTargetColumnNumber    As Long
    Dim FirstTargetColumnNumber     As Long
'
            For j = targetlastrow To 2 Step -1
'           For j = 2 To targetlastrow
                If targetsheet.Range("B" & j).Value = ActiveSheet.Range("c4").Value Then
                    ActiveSheetColumnNumber = 1
                    ActiveSheetRow = 9
                    FirstTargetColumnNumber = 26
                    SecondTargetColumnNumber = 89
'
'------------------------------------------------------------------------------------------------
'
'                   A thru AK
                    For SecondTargetColumnNumber = 89 To 197 Step 3
                        If ActiveSheet.Range("A" & ActiveSheetRow).Value = "" Then
                            ActiveSheet.Range("A" & ActiveSheetRow).Value = Split(Cells(1, ActiveSheetColumnNumber).Address, "$")(1)
                            ActiveSheet.Range("B" & ActiveSheetRow).Value = targetsheet.Cells(j, SecondTargetColumnNumber + 1).Value
                            ActiveSheet.Range("C" & ActiveSheetRow).Value = targetsheet.Cells(j, SecondTargetColumnNumber + 2).Value
                            ActiveSheet.Range("D" & ActiveSheetRow).Value = targetsheet.Cells(j, SecondTargetColumnNumber).Value
                        End If
'
                        If Application.WorksheetFunction.CountA(ActiveSheet.Range("F" & ActiveSheetRow & _
                                ":O" & ActiveSheetRow)) = 10 Then GoTo PrepForNextRow                           ' Check for all cells Fx:Ox filled
'
'                       Loop through columns F:O to find first blank cell in that range of ActiveSheetRow #
                        For i = 6 To 15
                            If LenB(WorksheetFunction.Trim(Cells(ActiveSheetRow, i))) = 0 Then
                                EmptyColumnCell = i
                                Exit For
                            End If
                        Next
'
                        ActiveSheet.Cells(ActiveSheetRow, EmptyColumnCell).Value = targetsheet.Cells(j, FirstTargetColumnNumber).Value
'
PrepForNextRow:
                        ActiveSheetColumnNumber = ActiveSheetColumnNumber + 1
                        ActiveSheetRow = ActiveSheetRow + 1
                        FirstTargetColumnNumber = FirstTargetColumnNumber + 1
                    Next
'
'------------------------------------------------------------------------------------------------
'
                End If
            Next j
        End If
    Next
End Sub

It checks to see if F:O range is completely full in a row, and if so, it starts the processing of the next row.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
What's the best way to pull data from this sheet?
Replies
1
Views
114
bobaol
B
A
  • Question
input data from another workbook
Replies
1
Views
424
atditiljazi
A
A
  • Question
Importing cell values from multiple workbooks in one folder
Replies
2
Views
787
Albertu95
A
D
  • Solved
Pulling data from sheet to table on another sheet with excel VBA
Replies
1
Views
791
DanSMT
D
T
  • Question
Insert/Delete Columns issue via VBA
Replies
1
Views
679
Tdorman
T

Forum statistics

Threads
1,216,104
Messages
6,128,856
Members
449,472
Latest member
ebc9

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top