Retrieving value from another sheet based on column

Hello guys,

I've been working on a macro (with the help from this forum) that condenses data from multiple ranges to a new sheet. I'm almost done with the macro but I'm stuck on this one final part.

I've attached an example but I'll explain the scenario.

The raw datasets are in ranges that are 3 columns wide.
the macro so far lists all the unique instances in the first sheet into one range.
What I'm having trouble with is grabbing the counts from the ranges in sheet 1 to the condensed range.

Can anyone point me in the right direction??

Also, if anyone wants the macro I have so far, I would be glad to share it.

kookymonster

Would you mind re-attaching the workbook with the code. It probably could be modified to do what you want.

Thanks for taking the time to take a look.

This is the code I have so far. Everything up to
" 'Gets counts from sheet 1" works. After that, i've just been trying out different things with no success

Sub Unique()

Dim Num_sources As Byte
Dim I As Long
Dim J As Long
Dim K As Long
Dim L As Long
Dim Sheet1 As Worksheet
Dim UniqueIPI As Worksheet
Dim Title As String
Dim Mycount As Long

'All the source ranges
Range("A3:C" & Range("C3").End(xlDown).Row).Name = "S1.ipi"
Range("E3:G" & Range("G3").End(xlDown).Row).Name = "S2.ipi"
Range("I3:K" & Range("K3").End(xlDown).Row).Name = "S3.ipi"
Range("M3:O" & Range("O3").End(xlDown).Row).Name = "S4.ipi"
Range("Q3:S" & Range("S3").End(xlDown).Row).Name = "S5.ipi"
Range("U3:W" & Range("W3").End(xlDown).Row).Name = "S6.ipi"
Range("Y3:AA" & Range("AA3").End(xlDown).Row).Name = "S7.ipi"
Range("AC3:AE" & Range("AE3").End(xlDown).Row).Name = "S8.ipi"
Range("AG3:AI" & Range("AI3").End(xlDown).Row).Name = "S9.ipi"
Range("AK3:AM" & Range("AM3").End(xlDown).Row).Name = "S10.ipi"
Range("AO3:AQ" & Range("AQ3").End(xlDown).Row).Name = "S11.ipi"
Range("AS3:AU" & Range("AU3").End(xlDown).Row).Name = "S12.ipi"
Range("AW3:AY" & Range("AY3").End(xlDown).Row).Name = "S13.ipi"
Range("BA3:BC" & Range("BC3").End(xlDown).Row).Name = "S14.ipi"
Range("BE3:BG" & Range("BG3").End(xlDown).Row).Name = "S15.ipi"
Range("BI3:BK" & Range("BK3").End(xlDown).Row).Name = "S16.ipi"
Range("BM3:BO" & Range("BO3").End(xlDown).Row).Name = "S17.ipi"
Range("BQ3:BS" & Range("BS3").End(xlDown).Row).Name = "S18.ipi"
Range("BU3:BW" & Range("BW3").End(xlDown).Row).Name = "S19.ipi"
Range("BY3:CA" & Range("CA3").End(xlDown).Row).Name = "S20.ipi"
Range("CC3:CE" & Range("CE3").End(xlDown).Row).Name = "S21.ipi"
Range("CG3:CI" & Range("CI3").End(xlDown).Row).Name = "S22.ipi"
Range("CK3:CM" & Range("CM3").End(xlDown).Row).Name = "S23.ipi"
Range("CO3:CQ" & Range("CQ3").End(xlDown).Row).Name = "S24.ipi"
Range("CS3:CU" & Range("CU3").End(xlDown).Row).Name = "S25.ipi"
Range("CW3:CY" & Range("CY3").End(xlDown).Row).Name = "S26.ipi"
Range("DA3:DC" & Range("DC3").End(xlDown).Row).Name = "S27.ipi"
Range("DE3:DG" & Range("DG3").End(xlDown).Row).Name = "S28.ipi"

Sheets.Add.Name = "UniqueIPI"
Sheets("UniqueIPI").Activate
Cells(1, 1).Value = "Unique IPI"
Cells(2, 1).Value = "Description"
Cells(2, 2).Value = "IPI"

Sheets("Sheet1").Activate

Num_sources = Application.InputBox(prompt:="Number of sources?", Title:="UniqueIPI V.1", Type:=1)

Sheets("UniqueIPI").Activate

For J = 1 To Num_sources
    Sheets("Sheet1").Range("S" & J & ".IPI").Copy _
    Destination:=Sheets("UniqueIPI").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next J

'Removing Duplicates Part
Columns(3).EntireColumn.Delete

Sheets("UniqueIPI").Range("A3:C" & Range("C3").End(xlDown).Row).Select

Sheets("UniqueIPI").Range("A3:C" & Range("C3").End(xlDown).Row).removeduplicates Columns:=2, Header:=xlNo

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Gathering Information from Sheet 1 Part'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 Range("A3:B" & Range("B3").End(xlDown).Row).Name = "Uniquedone.IPI"
 
 'Gathers Title from Sheet 1
 For L = 1 To Num_sources
    
    Sheets("Sheet1").Cells(1, 1 + 4 * (L - 1)).Copy _
    Destination:=Sheets("UniqueIPI").Cells(2, L + 2)
    Next L


'Gets Counts from Sheet 1
    For K = 1 To Num_sources
    Cells(3, K + 2).Select
    Mycount = Application.CountA(Range("A:A"))
    ActiveCell.Value = WorksheetFunction.VLookup(B3, S1.IPI, 3, False)
    Selection.AutoFill Destination:=Range("C3:C&Mycount"), Type:=xlFillDefault
    Next K
    
    
    
    
    

End Sub

Here is one way to move your data?

Sub Get_Data()
Dim cell As Object
Dim r As Range
Dim lrow As Long
Dim x As Integer, i As Integer

lrow = Sheets(1).Range("A65536").End(xlUp).Row
Set r = Sheets(1).Range("A3:A" & lrow)
For Each cell In r

myid = cell.Offset(, 1).Value
myval = cell.Offset(, 2).Value
    With Sheets(2)
        Set rFound = .UsedRange.Find(What:=myid, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                 
        If Not rFound Is Nothing Then
            rFound.Offset(, 1).Value = myval
        End If
    End With
Next cell
Set r = Sheets(1).Range("E3:E" & lrow)
For Each cell In r

myid = cell.Offset(, 1).Value
myval = cell.Offset(, 2).Value
    With Sheets(2)
        Set rFound = .UsedRange.Find(What:=myid, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                 
        If Not rFound Is Nothing Then
            rFound.Offset(, 2).Value = myval
        End If
    End With
Next cell
Set r = Sheets(1).Range("I3:I" & lrow)
For Each cell In r

myid = cell.Offset(, 1).Value
myval = cell.Offset(, 2).Value
    With Sheets(2)
        Set rFound = .UsedRange.Find(What:=myid, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                 
        If Not rFound Is Nothing Then
            rFound.Offset(, 3).Value = myval
        End If
            
    End With
Next cell
lrow = Sheets(2).Range("B65536").End(xlUp).Row
With Sheets(2)
For i = 3 To 5
    For x = 3 To lrow
        If Sheets(2).Cells(x, i).Value = vbNullString Then
            Sheets(2).Cells(x, i).Value = 0
        End If
    Next x
Next i
End With
 
End Sub

...