Extract Data from Adjacent Cell - Two Deep

drmingle

Board Regular
Joined
Oct 5, 2009
Messages
229
EncIDAdmit DateDischarge DateService CountService Hit
12311/1/20111/15/20117OBGYN
12321/1/20111/15/20117OBGYN
12331/1/20111/15/20116OBGYN
12341/1/20111/15/20116Heart
12351/1/20111/15/20115Heart
12361/1/20111/15/20115Lung
12371/1/20111/15/20115Lung
12381/1/20111/15/20114Lung
12391/1/20111/15/20114Lung
12401/1/20111/15/20114Maternity

<tbody>
</tbody>

I am needing vba code to do the following:
  • Pull back the first two EncIDs per service (OBGYN, Heart, etc) and place it in another sheet one after the other (not in the same cell)
For example, I would the below outcome for the data I have supplied:
1231
1232
1234
1235
1236
1237
1240

Thank you in advance for your help.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
One method I thought about doing was to unique the list first to create a set of values to search for using a vlookup. but my logic breaks down when I have to account for two or more OBGYN, Heart, etc...

How do I use a vlookup to capture the first ID and then capture the next in the series of the group I have referenced (i.e. OBGYN, Heart,etc)?
 
Upvote 0
Try this,
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Sub EncID()

    Dim lRow As Long
    Dim bCount As Byte
    Dim sServiceHit As String
    Dim rRange As Range, rCell As Range
    Dim ws As Worksheet

    Sheets("Sheet1").Select
    Set ws = Sheets("Sheet2")
    ws.Range("A1") = "EncID"
    Set rRange = Range("A2", Range("A" & Rows.Count).End(xlUp))

    lRow = 2
    For Each rCell In rRange
        If sServiceHit <> rCell.Offset(, 4) Then
           sServiceHit = rCell.Offset(, 4)
           bCount = 0
        End If
        If bCount < 2 Then
            ws.Cells(lRow, "A") = rCell
            bCount = bCount + 1
            lRow = lRow + 1
        End If
    Next rCell

End Sub[/COLOR][/SIZE][/FONT]
 
Upvote 0
Below is my unique list code and my rearrange code. I have the vlookup code on the worksheet itself which references the unique list. The only problem I am having now is that I am pulling back one EncID value per category and I need 2. I know vlookup alone will not be able to complete this, but I am at a loss for what could resolve this...

Code:
Sub Shrink()
'
' Shrink Macro: Create a unique list; Clean up list on active sheet; deposit new list on sheet
'

'
    Range("E2:E11").Select
    Sheets("Data").Select
    Range("E1:E11").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "G2"), Unique:=True
    Range("G2:G6").Select
    Selection.Cut
    Sheets("Chouse").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Data").Select
    Range("E1").Select
End Sub
Sub A_RearrangeData()
'
' A_RearrangeData Macro
'

'
    Range("A1:D11").Select
    Selection.Cut Destination:=Range("F1:I11")
    Range("F1:I11").Select
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Range("I5").Select
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,212,099
Messages
6,105,955
Members
447,986
Latest member
dicklim39

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