VBA script to search for info

[matrix26]

Hi,

I have a workbook that has 3 worksheets. DEVICE INFO, CCT INFO, SIA.

I'm trying to create a VBA macro that will ask the user to select a range from column A on worksheet DEVICE INFO
then I want the script to use that selected range to look up column A on worksheet CCT INFO in order to find the corresponding data for that device in column B of worksheet CCT INFO.
then I need the script to copy everything to worksheet SIA in the following format

Service Affected

Customer

Sub-Group

Service Impact

Address

Service Type

Service Model

Customer Reference

Node

Notify

Circuit Status

Tail Circuit

Customer PID

Key Owner

TEST DATA 2

customer name

test data

Loss of Service

business address

IPVPN Access

N/A

N/A

test device name 1

Yes

Live

TEST DATA 2

N/A

N/A

TEST DATA 3

customer name

test data

Loss of Service

business address

IPVPN Access

N/A

N/A

test device name 2

Yes

Live

TEST DATA 3

N/A

N/A

Service Affected and Tail Circuit data comes from the CCT INFO worksheet, whereas Node comes from the copied range on worksheet DEVICE INFO
I can get the script to do everything I need EXCEPT sometimes in the worksheet CCT INFO contains multiple entries for the NODE with different details in worksheet CCT INFO column B.

i.e CCT INFO might have the following data
test device name 1 TEST DATA 2
test device name 1 TEST DATA 4
test device name 1 TEST DATA

I can't get my script to find those extra entries, it always stops looking once it's found the 1st entry.

Can anyone help me amend my code so it works?

Here is the lookup part of my code
' Copy data from Column J of DEVICE INFO to Column B of SIA
lastRow = sia.Cells(sia.Rows.count, "B").End(xlUp).Row + 1
deviceRange.Offset(0, 9).Copy sia.Cells(lastRow, "B")

' Copy data from Column L of DEVICE INFO to Column E of SIA
deviceRange.Offset(0, 11).Copy sia.Cells(lastRow, "E")

' Perform lookup on CCT INFO and fill the corresponding data in SIA
lastRow = sia.Cells(sia.Rows.count, "I").End(xlUp).Row
Set lookupRange = cctInfo.Range("A:B")

For Each cell In sia.Range("I2:I" & lastRow)
Set lookupResult = lookupRange.Columns(1).Find(What:=cell.value, LookAt:=xlWhole)
If Not lookupResult Is Nothing Then
sia.Cells(cell.Row, "A").value = lookupResult.Offset(0, 1).value ' Populate column A with corresponding value from CCT INFO
sia.Cells(cell.Row, "C").value = "C&WW"
sia.Cells(cell.Row, "D").value = "Loss of Service"
sia.Cells(cell.Row, "F").value = "IPVPN Access"
sia.Cells(cell.Row, "G").value = "N/A"
sia.Cells(cell.Row, "H").value = "N/A"
sia.Cells(cell.Row, "J").value = "Yes"
sia.Cells(cell.Row, "K").value = "Live"
sia.Cells(cell.Row, "L").value = lookupResult.Offset(0, 1).value ' Populate column A with corresponding value from CCT INFO
sia.Cells(cell.Row, "M").value = "N/A"
sia.Cells(cell.Row, "N").value = "N/A"
Else
MsgBox "Entry not found for device: " & cell.value
End If
Next cell

MsgBox "Data copied to SIA successfully!"

 

[DanteAmor]

Hi @matrix26 .

Thanks for posting on MrExcel.​

I can't get my script to find those extra entries, it always stops looking once it's found the 1st entry.

Suppose I help you perform all the searches.
According to your data, in row 2, in column "I" you have this node: "test device name 1", in that same row you are going to put the result "TEST DATA 2".
Where do you want to put the results "TEST DATA 4" and "TEST DATA"?

In order for me to give you a complete macro, please give examples of your 3 sheets before the macro and a fourth example of how you want the result.

Without that information it is very difficult to help you.

Give the 4 examples using the XL2BB tool,

-----------------------
Note XL2BB:​

For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

----------------------
Note Code Tag:​

In future please use code tags when posting code and post the full macro.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

 

[matrix26]

Hi @matrix26 .

Thanks for posting on MrExcel.​

Suppose I help you perform all the searches.
According to your data, in row 2, in column "I" you have this node: "test device name 1", in that same row you are going to put the result "TEST DATA 2".
Where do you want to put the results "TEST DATA 4" and "TEST DATA"?

In order for me to give you a complete macro, please give examples of your 3 sheets before the macro and a fourth example of how you want the result.

Without that information it is very difficult to help you.

Give the 4 examples using the XL2BB tool,

-----------------------
Note XL2BB:​

For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

----------------------
Note Code Tag:​

In future please use code tags when posting code and post the full macro.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

DEVICE INFO sheet looks like this

Hostname	Batch Number	Part Number	os version	Serial Number	IP address	Customer Domain	Status	CCT In LCM INFO List	Customer Name	Change Window	Customer Address
TEST DEVICE 1	1	ABSDEFG	16.06.10	XXXXXXXX	XXXXXXX	TEST CUSTOMER DOMAIN 1	RESPONSIVE	Y	TEST CUSTOMER NAME	8PM-6AM	TEST ADDRESS 1
TEST DEVICE 2	1	ABSDEFG	16.06.10	XXXXXXXX	XXXXXXX	TEST CUSTOMER DOMAIN 2	RESPONSIVE	Y	TEST CUSTOMER NAME	8PM-6AM	TEST ADDRESS 2

CCT INFO sheet looks like this

Device	CCT
TEST DEVICE 1	TEST DATA 2
TEST DEVICE 1	TEST DATA 4
TEST DEVICE 1	TEST DATA
TEST DEVICE 2	TEST DATA 3

SIA sheet should look like this, when the macro has been run

Service Affected

Customer

Sub-Group

Service Impact

Address

Service Type

Service Model

Customer Reference

Node

Notify

Circuit Status

Tail Circuit

Customer PID

Key Owner

TEST DATA 2

TEST CUSTOMER NAME

C&WW

Loss of Service

TEST ADDRESS 1

IPVPN Access

N/A

N/A

TEST DEVICE 1

Yes

Live

TEST DATA 2

N/A

N/A

TEST DATA 4

TEST CUSTOMER NAME

C&WW

Loss of Service

TEST ADDRESS 1

IPVPN Access

N/A

N/A

TEST DEVICE 1

Yes

Live

TEST DATA 4

N/A

N/A

TEST DATA

TEST CUSTOMER NAME

C&WW

Loss of Service

TEST ADDRESS 1

IPVPN Access

N/A

N/A

TEST DEVICE 1

Yes

Live

TEST DATA

N/A

N/A

TEST DATA 3

TEST CUSTOMER NAME 2

C&WW

Loss of Service

TEST ADDRESS 2

IPVPN Access

N/A

N/A

TEST DEVICE 2

Yes

Live

TEST DATA 3

N/A

N/A

Currently my macro fills column 'sub group' with C&WW.
It fills column 'Service Impact' with Loss of Service
It fills column 'Service Type' with IPVPN Access
It fills columns 'service Model' & 'Customer Reference' with N/A
It fills column 'Notify' with Yes
It fills column 'Circuit Status' with Live
It fills columns 'Customer PID' & 'Key Owner' with N/A
The data in the above will never change.

My macro asks the use to select a range from column 'Hostname' on 'DEVICE INFO' worksheet
It uses that selected range to fill in column 'Node' on worksheet SIA
It also uses that selected range to copy 'Customer Name' & 'Customer Address' from DEVICE INFO and paste them in to their corresponding column on the SIA worksheet.
It then uses the selected data range from the DEVICE INFO worksheet to look up column 'DEVICE' on the CCT INFO worksheet.

So, based on the data above, it should search down the column Device until it finds ALL instances of 'TEST DEVICE 1' when it finds an instance of 'TEST DEVICE 1' it should copy the corresponding data from the column 'CCT' in the CCT INFO worksheet and paste that in to columns 'Service Affected' & 'Tail Circuit' on the SIA worksheet.
The macro should iterate until it finds all entries before moving on to the next 'Node' name in the list.

Does that make sense?

 

[DanteAmor]

Does that make sense?

Some things don't make sense.

--------
First, your macro doesn't do this:

My macro asks the use to select a range from column 'Hostname' on 'DEVICE INFO' worksheet

--------
Second, you did not put the examples using the XL2BB tool, you have to understand, that the way you put the examples, it is difficult to know in which row and in which column the data is.

--------
Third, I asked you for a sample of your data from the "SIA" sheet before the macro, but you didn't put it.

--------
Fourth, this part of your macro is confusing:

For Each cell In sia.Range("I2:I" & lastRow)

Why do you perform the cycle on the sheet "Sia"?
According to your request that sheet will be filled with the macro. I would assume that it is empty, but apparently it already has data, so the Third point becomes more relevant.
If data already exists, how are the new data going to be inserted, are lines going to be inserted or going to the end of the data?

--------
Last, it would also help if you put your complete macro, maybe that will help to solve some doubts.

Please answer all the points, they are essential.

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​

 

[matrix26]

Sorry for the delay. Work got really busy.

Hope this helps

point 1. It asks the user to select a range from DEVICE INFO
point 2. I don't have XL2BB tool
point 3. Here is the SIA worksheet before the macro is run

Service Affected

Customer

Sub-Group

Service Impact

Address

Service Type

Service Model

Customer Reference

Node

Notify

Circuit Status

Tail Circuit

Customer PID

Key Owner

point 4. this line 'For Each cell In sia.Range("I2:I" & lastRow)' was to try and get the script to pick up all occurrences of the 'Node' in the CCT INFO search.

Here is the entire macro
Sub CopyDataToSIA()
Sheets("DEVICE INFO").Select

Dim deviceInfo As Worksheet
Dim sia As Worksheet
Dim cctInfo As Worksheet
Dim deviceRange As Range
Dim cell As Range
Dim lastRow As Long
Dim lookupRange As Range
Dim lookupResult As Range
Dim firstResult As Range
Dim nextResult As Range
Dim siaRow As Long ' Track the row number in the SIA sheet

' Set the worksheets
Set deviceInfo = ThisWorkbook.Worksheets("DEVICE INFO")
Set sia = ThisWorkbook.Worksheets("SIA")
Set cctInfo = ThisWorkbook.Worksheets("CCT INFO")

' Select the range of data in column A on DEVICE INFO
Set deviceRange = Application.InputBox("Select range in column A", Type:=8)

' Clear previous data in SIA
sia.Cells.CLEAR

' Set headers in SIA
sia.Range("A1:N1").value = Array("Service Affected", "Customer", "Sub-Group", "Service Impact", "Address", _
"Service Type", "Service Model", "Customer Reference", "Node", "Notify", _
"Circuit Status", "Tail Circuit", "Customer PID", "Key Owner")

' Copy device range to Column I of SIA
deviceRange.Copy sia.Cells(2, "I")

' Copy data from Column J of DEVICE INFO to Column B of SIA
lastRow = sia.Cells(sia.Rows.count, "B").End(xlUp).Row + 1
deviceRange.Offset(0, 9).Copy sia.Cells(lastRow, "B")

' Copy data from Column L of DEVICE INFO to Column E of SIA
deviceRange.Offset(0, 11).Copy sia.Cells(lastRow, "E")

' Perform lookup on CCT INFO and fill the corresponding data in SIA
lastRow = sia.Cells(sia.Rows.count, "I").End(xlUp).Row
Set lookupRange = cctInfo.Range("A:B")

siaRow = 2 ' Start from row 2 in the SIA sheet

For Each cell In sia.Range("I2:I" & lastRow)
Set lookupResult = lookupRange.Columns(1).Find(What:=cell.value, LookAt:=xlWhole)
If Not lookupResult Is Nothing Then
Set firstResult = lookupResult ' Store the first result

' Iterate over the matching entries
Do
sia.Cells(siaRow, "A").value = lookupResult.Offset(0, 1).value ' Populate column A with corresponding value from CCT INFO
sia.Cells(siaRow, "B").value = deviceInfo.Cells(lookupResult.Row, "J").value ' Copy data from Column J of DEVICE INFO to Column B of SIA
sia.Cells(siaRow, "C").value = "C&WW"
sia.Cells(siaRow, "D").value = "Loss of Service"
sia.Cells(siaRow, "E").value = deviceInfo.Cells(lookupResult.Row, "L").value ' Copy data from Column L of DEVICE INFO to Column E of SIA
sia.Cells(siaRow, "F").value = "IPVPN Access"
sia.Cells(siaRow, "G").value = "N/A"
sia.Cells(siaRow, "H").value = "N/A"
sia.Cells(siaRow, "I").value = deviceInfo.Cells(lookupResult.Row, "A").value ' Copy data from Column A of DEVICE INFO to Column I of SIA
sia.Cells(siaRow, "J").value = "Yes"
sia.Cells(siaRow, "K").value = "Live"
sia.Cells(siaRow, "L").value = lookupResult.Offset(0, 1).value ' Populate column L with corresponding value from CCT INFO
sia.Cells(siaRow, "M").value = "N/A"
sia.Cells(siaRow, "N").value = "N/A"

siaRow = siaRow + 1 ' Increment the row number in SIA sheet

Set nextResult = lookupRange.Columns(1).FindNext(lookupResult)
Set lookupResult = nextResult
Loop While Not nextResult Is Nothing And nextResult.Address <> firstResult.Address
Else
MsgBox "Entry not found for device: " & cell.value
End If
Next cell

MsgBox "Data copied to SIA successfully!"
End Sub

 

[DanteAmor]

Hi @matrix26

Try the following macro:

Sub CopyDataToSIA()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim deviceRange As Range, cell As Range, r As Range
  Dim dic As Object
  Dim b As Variant, itms As Variant
  Dim i As Long, k As Long
 
  ' Set the worksheets
  Set sh1 = ThisWorkbook.Worksheets("DEVICE INFO")
  Set sh2 = ThisWorkbook.Worksheets("CCT INFO")
  Set sh3 = ThisWorkbook.Worksheets("SIA")
  Set dic = CreateObject("Scripting.Dictionary")
 
  ' Select the range of data in column A on DEVICE INFO
  On Error Resume Next
  sh1.Select
  Set deviceRange = Application.InputBox("Select range in column A", Type:=8)
  If deviceRange Is Nothing Then Exit Sub
  On Error GoTo 0
 
  ' Store device and cct in a dictionary
  For Each cell In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(3))
    dic(cell.Value) = dic(cell.Value) & "|" & cell.Offset(, 1).Value
  Next
  ReDim b(1 To deviceRange.Rows.Count * dic.Count, 1 To Columns("N").Column)
 
  For Each r In deviceRange
    If dic.exists(r.Value) Then
      itms = Split(dic(r.Value), "|")
      For i = 1 To UBound(itms)
        k = k + 1
        b(k, 1) = itms(i)
        b(k, 2) = sh1.Range("J" & r.Row).Value
        b(k, 3) = "C&WW"
        b(k, 4) = "Loss of Service"
        b(k, 5) = sh1.Range("L" & r.Row).Value
        b(k, 6) = "IPVPN Access"
        b(k, 7) = "N/A"
        b(k, 8) = "N/A"
        b(k, 9) = sh1.Range("A" & r.Row).Value
        b(k, 10) = "Yes"
        b(k, 11) = "Live"
        b(k, 12) = itms(i)
        b(k, 13) = "N/A"
        b(k, 14) = "N/A"
      Next
    End If
  Next
 
  sh3.Range("2:" & Rows.Count).ClearContents
  sh3.Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

point 2. I don't have XL2BB tool​

You must install it, in post #2 is the link for you to review. The installation is very simple and once you use it you will have a better opportunity to receive help.​

---------------------

Code Tag:​

In future please use code tags when posting code and post the full macro.​

How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.​

 

[matrix26]

Hi @matrix26

Try the following macro:

Sub CopyDataToSIA()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim deviceRange As Range, cell As Range, r As Range
  Dim dic As Object
  Dim b As Variant, itms As Variant
  Dim i As Long, k As Long
 
  ' Set the worksheets
  Set sh1 = ThisWorkbook.Worksheets("DEVICE INFO")
  Set sh2 = ThisWorkbook.Worksheets("CCT INFO")
  Set sh3 = ThisWorkbook.Worksheets("SIA")
  Set dic = CreateObject("Scripting.Dictionary")
 
  ' Select the range of data in column A on DEVICE INFO
  On Error Resume Next
  sh1.Select
  Set deviceRange = Application.InputBox("Select range in column A", Type:=8)
  If deviceRange Is Nothing Then Exit Sub
  On Error GoTo 0
 
  ' Store device and cct in a dictionary
  For Each cell In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(3))
    dic(cell.Value) = dic(cell.Value) & "|" & cell.Offset(, 1).Value
  Next
  ReDim b(1 To deviceRange.Rows.Count * dic.Count, 1 To Columns("N").Column)
 
  For Each r In deviceRange
    If dic.exists(r.Value) Then
      itms = Split(dic(r.Value), "|")
      For i = 1 To UBound(itms)
        k = k + 1
        b(k, 1) = itms(i)
        b(k, 2) = sh1.Range("J" & r.Row).Value
        b(k, 3) = "C&WW"
        b(k, 4) = "Loss of Service"
        b(k, 5) = sh1.Range("L" & r.Row).Value
        b(k, 6) = "IPVPN Access"
        b(k, 7) = "N/A"
        b(k, 8) = "N/A"
        b(k, 9) = sh1.Range("A" & r.Row).Value
        b(k, 10) = "Yes"
        b(k, 11) = "Live"
        b(k, 12) = itms(i)
        b(k, 13) = "N/A"
        b(k, 14) = "N/A"
      Next
    End If
  Next
 
  sh3.Range("2:" & Rows.Count).ClearContents
  sh3.Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

You must install it, in post #2 is the link for you to review. The installation is very simple and once you use it you will have a better opportunity to receive help.​

---------------------

Code Tag:​

In future please use code tags when posting code and post the full macro.​

How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formattin​

Hi,

Unfortunately I can't install anything to this device as it's a works laptop and administrator privileges are locked out.

But your script is a work of art, thank you.

I had to add the line 'If Not r.EntireRow.Hidden Then'
But that's my fault cos I forgot to mention the data was filtered.

Again, thank you for your patience and this fantastic script.