Search Rows For Indicator, Return Certain Values

[SanFelippo]

Hi,

The Data I have covers 100 Rows and 266 Columns. The first 133 columns are going to simply contain either an “N” or a “Y” indicator. Ineed a Macro that I can attach to a button that when pressed, will go through the rows and search for the “N” indicators. If it finds an “N” indicator, I need it to do the following:

1. Grab the Column Header Name of the Column that is 133 Columns to the right of the Column it found the “N” indicator in and paste it onto a tab called “Error Tabulation” in cell B2.
2. Grab the value of the cell whose coordinates will be Cell (The current row being searched, Column EH) and paste it into cell D2.

There is more I need this Macro to do, but I figure I should start simple and then expand upon it once the base coding is done.


Any help is appreciated.

Thanks

 

[JoeMo]

Are there any formulas in the 100 Row x 266 Column range?
Do cells B1 and D1 on the Error Tabulation tab contain headers or are they empty?

 

[SanFelippo]

There are no calculation formulas, but every cell in the tab with all the indicators (Named "New Extract") is a link to another tab where it pulls over the value. The cells on the Error Tabulation tab do have headers. This is what it looks like:



Error Tabulation Tab

	A​	B​	C​	D​
1​	Finding or Observation​	HMDA Field​	Observation​	Application Number​

<tbody>
</tbody>

 

[JoeMo]

Here's some code you can try on a copy of your workbook (untested). Assumes the sheet with the 100 rows x 266 columns is the active sheet when you run the code and cols B & D of the Error Tabulation tab are cleared except for the headers before you run the code.

Sub SanFelippo()
Const Col As Long = 138   'Col EH, change to suit
Const ErrLet As String = "N"
Dim R As Range, Img As Variant, Ryn As Range, Imgyn As Variant, i As Long, j As Long
Dim CtTot As Long, Berrs As Variant, Derrs As Variant, CtN As Long
Set R = Range(Cells(1, 1), Cells(100, 266))
Img = R.Value
Set Ryn = R.Resize(100, 133)
CtTot = Application.CountIf(Ryn, ErrLet)
If CtTot = 0 Then Exit Sub
Imgyn = Ryn.Value
ReDim Berrs(1 To CtTot, 1 To 1): ReDim Derrs(1 To CtTot, 1 To 1)
For i = 1 To UBound(Imgyn, 1)
    For j = 1 To UBound(Imgyn, 2)
        If Imgyn(i, j) = ErrLet Then
            CtN = CtN + 1
            Berrs(CtN, 1) = Img(1, 133 + j): Derrs(CtN, 1) = Img(i, Col)
        End If
    Next j
Next i
Application.ScreenUpdating = False
With Sheets("Error Tabulation")
    .Range("B2:B" & CtN).Value = Berrs
    .Range("D2:D" & CtN).Value = Derrs
End With
Application.ScreenUpdating = True
End Sub

 

[SanFelippo]

Wow, that does exactly what I needed to do. That is awesome.So, remember in the beginning when I said there was more I needed it to do but I was just going to start simple? The good news is the only additional things Ineed are making the macro grab some other pieces of information and paste insome other columns on the error tabulation tab, exactly like it did with the application number. I have the cell coordinates of the additional pieces andwhere they need to get pasted. They are below:

Last Name – on New Extract Tab Cell (Row being searched,column HD), Pasted in Cell E2 on Error Tabulation Tab

Channel – on New Extract Tab Cell (Row being searched,column EF), Pasted in Cell F2 on Error Tabulation Tab

Notes – on New Extract Tab Cell (Row being searched, column JF), Pasted in Cell G2 on Error Tabulation Tab

Action Taken – on New Extract Tab Cell (Row being searched,column EF), Pasted in Cell H2 on Error Tabulation Tab

Loan Purpose – on New Extract Tab Cell (Row being searched,column EN), Pasted in Cell I2 on Error Tabulation Tab

Certified By – on New Extract Tab Cell (Row being searched,column ED), Pasted in Cell J2 on Error Tabulation Tab

Certified Date – on New Extract Tab Cell (Row being searched, column EE), Pasted in Cell K2 on Error Tabulation Tab



Also, can it be made so I can attach it to a button on the Error Tabulation Tab? That way the button can just be pressed there and it will run accordingly? Each time the button is pressed, could we have it also clearout what is on the Error Tabulation tab before it paste new things in? That wayI can avoid the situation where there were say 107 errors found so there are107 rows, but then a few get fixed and the macro is rerun and we are left withadditional rows at the bottom.


Thank you so much for this btw.

 

[SanFelippo]

Also, sorry, I noticed that the macro didn’t catch the lasttwo rows of data that are on the New Extract Tab. I made a mistake when tellingyou there were only 100 rows. There are 101 rows because the first row on thetab is a header row, and then there are 100 rows of actual data

 

[JoeMo]

Also, sorry, I noticed that the macro didn’t catch the lasttwo rows of data that are on the New Extract Tab. I made a mistake when tellingyou there were only 100 rows. There are 101 rows because the first row on thetab is a header row, and then there are 100 rows of actual data

Here's some revised code that will fix the extra row issue and also allow you to assign the code to a button on the Error Tabulation tab. I will look at all your additional requests in post #5 when I have time.

Sub SanFelippo()
Const Col As Long = 138   'Col EH, change to suit
Const ErrLet As String = "N"
Dim R As Range, Img As Variant, Ryn As Range, Imgyn As Variant, i As Long, j As Long
Dim CtTot As Long, Berrs As Variant, Derrs As Variant, CtN As Long
With Sheets("New Extract")
    Set R = .Range(.Cells(1, 1), .Cells(101, 266))
    Img = R.Value
    Set Ryn = R.Resize(101, 133)
    CtTot = Application.CountIf(Ryn, ErrLet)
    If CtTot = 0 Then
        MsgBox "No indicators found in the range: " & Ryn.Address(0, 0)
        Exit Sub
    End If
    Imgyn = Ryn.Value
    ReDim Berrs(1 To CtTot, 1 To 1): ReDim Derrs(1 To CtTot, 1 To 1)
    For i = 1 To UBound(Imgyn, 1)
        For j = 1 To UBound(Imgyn, 2)
            If Imgyn(i, j) = ErrLet Then
                CtN = CtN + 1
                Berrs(CtN, 1) = Img(1, 133 + j): Derrs(CtN, 1) = Img(i, Col)
            End If
        Next j
    Next i
End With
Application.ScreenUpdating = False
With Sheets("Error Tabulation")
    .Range(.Cells(2, "B"), .Cells(2, "B").End(xlDown)).ClearContents
    .Range(.Cells(2, "D"), .Cells(2, "D").End(xlDown)).ClearContents
    .Range("B2:B" & CtN + 1).Value = Berrs
    .Range("D2:D" & CtN + 1).Value = Derrs
End With
Application.ScreenUpdating = True
End Sub

 

[JoeMo]

I've factored in your other requests from post #5 in this version - at least I think I did, but you need to test it.

Sub SanFelippo()
Const ErrLet As String = "N"
Dim Col As Variant, ColNum As Long
Dim R As Range, Img As Variant, Ryn As Range, Imgyn As Variant, i As Long, j As Long
Dim CtTot As Long, Berrs As Variant, Info As Variant, CtN As Long
Col = Array(138, 212, 136, 266, 136, 144, 134, 135)
With Sheets("New Extract")
    Set R = .Range(.Cells(1, 1), .Cells(101, 266))
    Img = R.Value
    Set Ryn = R.Resize(101, 133)
    CtTot = Application.CountIf(Ryn, ErrLet)
    If CtTot = 0 Then
        MsgBox "No indicators found in the range: " & Ryn.Address(0, 0)
        Exit Sub
    End If
    Imgyn = Ryn.Value
    ReDim Berrs(1 To CtTot, 1 To 1): ReDim Info(1 To CtTot, 1 To UBound(Col) + 1)
    For i = 1 To UBound(Imgyn, 1)
        For j = 1 To UBound(Imgyn, 2)
            If Imgyn(i, j) = ErrLet Then
                CtN = CtN + 1
                Berrs(CtN, 1) = Img(1, 133 + j)
                For ColNum = LBound(Col) To UBound(Col)
                    Info(CtN, ColNum + 1) = Img(i, Col(ColNum))
                Next ColNum
            End If
        Next j
    Next i
End With
Application.ScreenUpdating = False
With Sheets("Error Tabulation")
    .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    .Range("B2:B" & CtN + 1).Value = Berrs
    .Range("D2:K" & CtN + 1).Value = Info
    .Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[SanFelippo]

I am in the process of testing the code and so fareverything is looking perfect. Man, I can follow the code for the most part (Iget a little lost at some points), but coming up with that on my own issomething I never could have done. How is it you got so good with this stuff?Did you take classes?
I would love to be able to learn how to do some of the stuffI have seen people do on this forum.

 

[JoeMo]

I am in the process of testing the code and so fareverything is looking perfect. Man, I can follow the code for the most part (Iget a little lost at some points), but coming up with that on my own issomething I never could have done.

Thanks for the update. Let me know how the rest of your testing turns out.