VBA - Multiple Values for one cell input

[Seandobson2402]

Good Morning,

I am trying to find a way to populate data into columns, based on a postcode entered into Shee7 (Postcode) "I14" and assigning a macro to a button titled search - which runs the function / routine once pressed. If no postcode is entered - I want a MsgBox "Please enter postcode" and if the postcode is not found, I would like a MsgBox saying "Postcode Not Found".

My main problem is returning multiple matches. I have 99000 rows of data on my main information sheet (Sheet1 "PC Data") Each post code can be used multiple times and have lots of address' linking to the postcode.

Below is the postcode sheet I want the sub / function to show information - B18 - N18 are the headers and I would like the values to be put below them (B-N19 and onwards)

Sheet7 (Postcode)
B18 (B2F ID)
C18 (UPRN)
D18 (Premise ID)
E18 (Post Code)
F18 (Address Line 1)
G18 (Address Line 2)
H18 (Address Line 3)
I18 (Customer Account Status)
J18 (SO CAT)
K18 (SME/MLE CAT)
L18 (Civils Costs)
M18 (Date Complete)
N18 (Comments)

Shee1 (PC Data) - source sheet (row 1 = headers and row 2 downwards = data to match)
A2 (B2F ID)
H2 (UPRN)
I2 (Premise ID) - Lookup Column
R2 (Post Code)
N2 (Address Line 1)
O2 (Address Line 2)
P2 (Address Line 3)
Y2 (Customer Account Status)
BL2 (SO CAT)
BM2 (SME/MLE CAT)
AN2 (Civils Costs)
E2 (Date Completed)
BX2 (Comments)


Basically, once the postcode has been entered and I press search. I want the routine to look through Sheet1, find the post code, copy the information detailed on that row into Sheet7, loop through the data and look for the next row that matches the postcode and do the same until no more are found.

Thanks for you help guy. Hopefully this can be done!​

​

 

[Seandobson2402]

I'm using the following code so far. However, this only brings one result (as I have only specified row 19) How would I rell the routing to search through all results with said postcode match and provide all information on rows 19, 20, 21, 22, 23 onwards?

Sub PostcodeSearchTest1SD()
    Dim Search As String
    Dim FoundCell As Range
    
    Search = Sheet7.Cells(14, 9).Value
    
    If Len(Search) > 0 Then
        Set FoundCell = Sheet1.Columns(18).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            
'B2F
            Sheet7.Cells(19, 2).Value = FoundCell.Offset(, -17)
'UPRN
            Sheet7.Cells(19, 3).Value = FoundCell.Offset(, -10).Value
'Premise ID
            Sheet7.Cells(19, 4).Value = FoundCell.Offset(, -9).Value
'Postcode
            Sheet7.Cells(19, 5).Value = FoundCell.Value
'Add1
            Sheet7.Cells(19, 6).Value = FoundCell.Offset(, -4).Value
'Add2
            Sheet7.Cells(19, 7).Value = FoundCell.Offset(, -3).Value
'Add3
            Sheet7.Cells(19, 8).Value = FoundCell.Offset(, -2).Value
'CA Status
            Sheet7.Cells(19, 9).Value = FoundCell.Offset(, 7).Value
'SO CAT
            Sheet7.Cells(19, 10).Value = FoundCell.Offset(, 46).Value
'SME CAT
            Sheet7.Cells(19, 11).Value = FoundCell.Offset(, 47).Value
'Civils
            Sheet7.Cells(19, 12).Value = FoundCell.Offset(, 22).Value
'Date
            Sheet7.Cells(19, 13).Value = FoundCell.Offset(, -13).Value
'Comments
            Sheet7.Cells(19, 14).Value = FoundCell.Offset(, 58).Value
             
        Else
            MsgBox Search & Chr(10) & "Postcode not found", 48, "Not Found"
        End If
        
    Else
        MsgBox "Please enter Postcode", 48, "Entry Required"
        
    End If
    
End Sub

 

[Fluff]

How about

Sub PostcodeSearchTest1SD()

   Dim Fnd As Range
   Dim Srch As String
   Dim Cnt As Long
   Dim Qty As Long
   Dim Ws As Worksheet
   Dim NxtRw As Long
   
   Set Ws = Sheet7
   Set Fnd = Ws.Range("B18")
   Srch = Ws.Range("I14").Value
   If Srch = "" Then
      MsgBox "No postcode entered"
      Exit Sub
   End If
   
   Qty = WorksheetFunction.CountIf(Ws.Columns(2), Srch)
   If Qty = 0 Then
      MsgBox "No postcode found"
      Exit Sub
   End If
   With Sheet1
      For Cnt = 1 To Qty
         Set Fnd = Ws.Range("B:B").Find(Srch, Fnd, , xlWhole, , , False, , False)
         NxtRw = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
         Fnd.Copy .Range("A" & NxtRw)
         Fnd.Offset(, 1).Resize(, 2).Copy .Range("H" & NxtRw)
         Fnd.Offset(, 4).Copy .Range("R" & NxtRw)
      Next Cnt
   End With
   
End Sub

This will do cols B to E, just add the rest in a similar manner

 

[Seandobson2402]

Hi Fluff. Apologies, but I can't quite seem to understand how this will take the information from Sheet1 and Input it onto Sheet7 based on the Value of "I14".

Big thank you for replying - I'm new to VBA so I'm still trying to wrap my head around some of the coding.

 

[Fluff]

Apologies, I must have gotten a bit confused when I wrote that. Try

Sub PostcodeSearchTest1SD()

   Dim Fnd As Range
   Dim Srch As String
   Dim Cnt As Long
   Dim Qty As Long
   Dim Ws As Worksheet
   Dim NxtRw As Long
   
   Set Ws = Sheet1
   Set Fnd = Ws.Range("R1")
   Srch = Sheet7.Range("I14").Value
   If Srch = "" Then
      MsgBox "No postcode entered"
      Exit Sub
   End If
   
   Qty = WorksheetFunction.CountIf(Ws.Columns(2), Srch)
   If Qty = 0 Then
      MsgBox "No postcode found"
      Exit Sub
   End If
   With Sheet7
      For Cnt = 1 To Qty
         Set Fnd = Ws.Range("R:R").Find(Srch, Fnd, , xlWhole, , , False, , False)
         NxtRw = .Range("B" & Rows.Count).End(xlUp).Offset(1).Row
         Fnd.Offset(, -17).Copy .Range("B" & NxtRw)
         Fnd.Offset(, -10).Resize(, 2).Copy .Range("C" & NxtRw)
         Fnd.Offset.Copy .Range("E" & NxtRw)
      Next Cnt
   End With
   
End Sub

 

[Seandobson2402]

Thanks Fluff - I will give this a go today much appreciated.

 

[Seandobson2402]

Doesn't seem like the postcode being entered into Sheet7 "I14" is being matched against Sheet1 Range "R1".

 

[Fluff]

Do you meant that the code does not find any matches?

 

[Seandobson2402]

Exactly. No matches are being found

 

[Fluff]

Oops, missed a bit. It should be

Qty = WorksheetFunction.CountIf(Ws.Columns([COLOR=#ff0000]18[/COLOR]), Srch)