0

Good day I have a table with data, one of the columns have a number (There are repeating numbers) and the other column has letters and the last column has the feedback.

My entries change every day and I want to have one space where I can put today's Number, letter and feedback and then create a button that looks for the letter and number in the table and posts the feedback

Data Table:

Number  Letter  Feedback         Todays Number   Todays letter   Todays Feedback
1       A                        3               B               100
1       B
2       A
2       B
3       A
3       B       
4       A
4       B
5       A
5       B

There is a similar problem posted on stack overflow and I tried to use a similar method, but this only works for searching against one criteria:

I have the following:

Private Sub CommandButton1_Click()
Dim MatchFormula As Long

MatchFormula = WorksheetFunction.Match(Range("Number"), Range("A:A"), 0)

Range("c" & MatchFormula).Value = Range("f2").Value
End Sub

Please assist enter image description here

SJR
  • 22,986
  • 6
  • 18
  • 26
Constantia
  • 11
  • 1
  • 3

3 Answers3

1

You can use AutoFilter with 2 criterias to achieve this.

Code

Option Explicit

Sub AutoFilt()

Dim Sht As Worksheet
Dim Rng As Range, VisRng As Range, FiltRngArea As Range
Dim LastRow As Long

Set Sht = ThisWorkbook.Sheets("Sheet1") ' modife "Sheet1" to your sheet's name

With Sht
    .Range("A1:C1").AutoFilter

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"

    With .Range("A1:C" & LastRow)
        .AutoFilter field:=1, Criteria1:=.Range("E2").Value2
        .AutoFilter field:=2, Criteria1:=.Range("F2").Value2

        ' set the visible rows range after Auto-Filter was applied
        Set VisRng = .SpecialCells(xlCellTypeVisible)

        ' loop through areas of Filterred Range
        For Each FiltRngArea In VisRng.Areas
            If FiltRngArea.Row > 1 Then ' not header row
                FiltRngArea.Cells(1, 3).Value = .Range("G2").Value ' set the value
            End If
        Next FiltRngArea

    End With

End With

End Sub
Shai Rado
  • 33,032
  • 6
  • 29
  • 51
0

Another approach:

Option Explicit

Private Sub CommandButton1_Click()

    Dim rngNumbers As Range
    Dim varCounter As Variant
    Dim intTodaysNumber As Integer
    Dim strTodaysLetter As String

    'Determine numbers range and filter arguments
    With ThisWorkbook.Worksheets("Tabelle1")
        Set rngNumbers = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
        intTodaysNumber = .Range("F2").Value
        strTodaysLetter = .Range("G2").Value

        'Loop through numbers range and compare number and letter
        For Each varCounter In rngNumbers
            If varCounter.Value = intTodaysNumber And _
               varCounter.Offset(0, 1).Value = strTodaysLetter Then
               'Write found feedback value    
               .Range("H2") = varCounter.Offset(0, 2).Value
               debug.print "Entry found for number " & intTodaysNumber & _
                           " and letter " & strTodaysLetter & _
                           " at row " & varCounter.Row & " and column " & _
                            varCounter.Column
               Exit For
            End If
        Next varCounter
    End With
End Sub
Chrowno
  • 198
  • 6
  • The filter method just hides my rows and does not copy my feedback entry.Working through the code now to see if I can adapt it. – Constantia Dec 19 '17 at 14:36
  • I understand what the alternative approach is suppose to do but my current 'todays feedback' just dissapears from cell h2 and nothing else happens. – Constantia Dec 19 '17 at 14:37
  • Well in your example table there are empty rows in your columns. Do the columns for the 2 search parameters fit? If so, set a stop mark where it writes the value and check the values set in the local window. Or just use the debug.print I added – Chrowno Dec 19 '17 at 17:21
0

Thank you for all the comments and answers. Helped a lot

Here is what worked in the end:

Private Sub CommandButton2_Click()

Dim MatchNumber As Long  'The First Row number with  the matching Number'
Dim LastRow As Long      'The Last Row number with matching Number'
Dim MatchLetter As Long  'The First Row Number with Matching number and matching letter'
Dim Post As Long         'The Row Number where the feedback need sto be posted'



'Find the Row in Column A:A the matches the value in the Number range

MatchNumber = WorksheetFunction.Match(Range("Number"), Range("a:a"), 0)

'Find the Last row that mathces the number (+1 because there is only 2 entries for each number, if there was 4 entries per number then +3)
LastRow = MatchNumber + 1

'Find the Matching Letter in the new range
MatchLetter = WorksheetFunction.Match(Range("Letter"), Range(Cells(MatchNumber, 2), Cells(LastRow, 2)), 0)

'The Row number where the feedback need sto be posted
Post = MatchLetter + MatchNumber - 1

'Post the value captured in h2 to column c in the 'post' row
Range("c" & Post).Value = Range("h2").Value

End Sub
Constantia
  • 11
  • 1
  • 3