VBA Matching value in a range and return other cell values

Jasesair

Active Member
Joined
Apr 8, 2015
Messages
282
Office Version
  1. 2016
I didn't think this would be difficult...but perhaps I'm not thinking clearly.

I have values in cells H8:K8 from sheet 'Data Entry'. In sheet 'Results', I'm wanting to match A1 with A1's unique value in column F (it's long but if a range is needed, then F3:F6000). Once matched, I'd like the H8:K8 'Data Entry' cells to be returned in column H:K in the matched row in the 'Results' sheet. I hope that's making sense - I'm sure I could have explained that far better!!!

Is this possible with a little VBA?
 
You're welcome. Thanks for the follow-up. :)

(BTW, I have updated my previous code to include the "+1" so that future readers looking at the Accepted solution will already have it included.)
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Peter, sorry to be the pain I know I am...

I've just started picking up a Run-Time 91 in the Set rngData row. Before I revert back to an old version of what I'm doing, I thought I'd check if this was an easy fix or not.
 
Upvote 0
I thought I'd check if this was an easy fix or not.
Well, we would have to determine what was causing the error to decide if a fix is easy. I didn't get the error.

One reason could be that there is nothing in columns H:K of 'Data Entry'. If that is the case, I'm wondering why would you be running the code?
Can you confirm that any data that has to be processed from those columns starts at row 8?
If there is data in those columns, perhaps you could post it or try to decide what is so different compared to the sample previously given in post #6

Also, always a good idea to quote the full error message when you get one.
 
Upvote 0
A new day now isn't producing this error. After lots of playing, I'm getting a different Run-time error '13' Type mismatch. This is highlighting the 5 rows above 'With Sheets("Results") and is occurring when there is only data in row h of 'Data Entry' and not values in any other row. As soon as there is some data in any other row, the macro works perfectly, whether there's any data in row H or not.

I can confirm that data does start in row 8.
 
Upvote 0
See if this is any better.

VBA Code:
Sub ToOneRow_v2()
  Dim Results As Variant
  Dim rngData As Range, rngFound As Range
  Dim lr As Long
  
  With Sheets("Data Entry")
    On Error Resume Next
    lr = .Range("H:K").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    If lr >= 8 Then
      Set rngData = .Range("H8:K" & lr)
    End If
  End With
  If rngData Is Nothing Then
    MsgBox "No data in 'Data Entry' H:K from row 8"
  Else
    If rngData.Rows.Count = 1 Then
      Results = Split(Join(Application.Index(rngData.Value, 1, 0), "@"), "@")
    Else
      Results = Split(Join(Application.Transpose(Evaluate( _
              rngData.Columns(1).Address(External:=True) & "&""@""&" & _
              rngData.Columns(2).Address(External:=True) & "&""@""&" & _
              rngData.Columns(3).Address(External:=True) & "&""@""&" & _
              rngData.Columns(4).Address(External:=True))), "@"), "@")
    End If
    With Sheets("Results")
      Set rngFound = .Columns("F").Find(what:=.Range("A1").Value, LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
        rngFound.Offset(, 2).Resize(, UBound(Results) + 1).Value = Results
      Else
        MsgBox .Range("A1").Value & " not found in column F"
      End If
    End With
  End If
End Sub
 
Upvote 0
That's fantastic, and particularly good to have the message box. Just to ask one more question...I'm trying to hide columns H:K in 'Data Entry'. This is what's producing the Run-time Error 91. Would you expect the fix, to hide and unhide the columns, to be needed in the above macro or elsewhere in my Workbook?
 
Upvote 0
We need to determine what the last row with data in columns H:K is. Currently I am using the Find method
Rich (BB code):
lr = .Range("H:K").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Find does not work on hidden data. Choices would include ..
  1. Unhide the columns, find the last row, hide the columns
  2. With the columns hidden, we could check each of the 4 columns individually with another method that works on hidden columns and then choose the largest row value.
  3. Some other method that you might know because you are familiar with your data
What do you think would be best for you?
 
Upvote 0
I guess just some VBA to unhide, find the last row, then hide again should work perfectly.
 
Upvote 0
OK, try this one.

VBA Code:
Sub ToOneRow_v3()
  Dim Results As Variant
  Dim rngData As Range, rngFound As Range
  Dim lr As Long
  Dim bColsHidden As Boolean
  
  Application.ScreenUpdating = False
  With Sheets("Data Entry")
    bColsHidden = .Columns("H").Hidden
    .Columns("H:K").Hidden = False
    On Error Resume Next
    lr = .Range("H:K").Find(what:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    If lr >= 8 Then
      Set rngData = .Range("H8:K" & lr)
    End If
    .Columns("H:K").Hidden = bColsHidden
  End With
  Application.ScreenUpdating = True
  If rngData Is Nothing Then
    MsgBox "No data in 'Data Entry' H:K from row 8"
  Else
    If rngData.Rows.Count = 1 Then
      Results = Split(Join(Application.Index(rngData.Value, 1, 0), "@"), "@")
    Else
      Results = Split(Join(Application.Transpose(Evaluate( _
              rngData.Columns(1).Address(External:=True) & "&""@""&" & _
              rngData.Columns(2).Address(External:=True) & "&""@""&" & _
              rngData.Columns(3).Address(External:=True) & "&""@""&" & _
              rngData.Columns(4).Address(External:=True))), "@"), "@")
    End If
    With Sheets("Results")
      Set rngFound = .Columns("F").Find(what:=.Range("A1").Value, LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
        rngFound.Offset(, 2).Resize(, UBound(Results) + 1).Value = Results
      Else
        MsgBox .Range("A1").Value & " not found in column F"
      End If
    End With
  End If
End Sub
 
Upvote 0
Hi Peter. This VBA Code has been brilliant. I do have a query and thought you'd be the best person to ask about it...

When the code is run, the figures are transposed as hoped. When hovering over one of the transposed figures, it says, 'The number in this cell is formatted as text or preceded by an apostrophe. Everything is working perfectly so I don't want to change things, but when I go to enter some figures manually, they're not behaving like the transposed figures. This all means I'm not able to retrieve them later with a report I run. I've attempted to format the cells to be 'text' to try and replicate the transposed figures but this hasn't helped. Any ideas?
 
Upvote 0

Forum statistics

Threads
1,215,220
Messages
6,123,697
Members
449,117
Latest member
Aaagu

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