Help modifying my VBA code to output another column

kfg1287

New Member
Joined
Mar 4, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
My VBA knowledge is basic but my coworker on leave has left me with this code to modify. I attached the VBA code that compares worksheet 2, 3, 4, and outputs what's not in worksheet 2 to worksheet 1. It works great but I cant seem to figure out how to bring the other " Model" column associated with the "Ip address" cells result.

For example

Worksheet 2
column B = Ip address column C = Model

my code outputs the ip addresses from worksheet 2 to worksheet 1 column E but not the "Model"
Any modifications to input the model number associated with the ip address to worksheet 1 column F?



VBA code

Sub ()
'Excel vba to remove duplicates.

Dim dic As Object
Dim ar As Variant
Dim ar1 As Variant
Dim var As Variant
Dim i As Long
Dim n As Long

Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
ar = Sheet2.Range("B2", Sheet2.Range("B" & Rows.Count).End(xlUp)).Value
var = Sheet4.Range("D2", Sheet4.Range("D" & Rows.Count).End(xlUp)).Value
var = Sheet3.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Value
ReDim ar1(1 To UBound(var), 1 To 1)

'Loop through ar and add to Dictionary.
For i = 1 To UBound(ar)
If Not dic.exists(ar(i, 1)) Then
dic.Add ar(i, 1), ar(i, 1)
End If
Next i

'Identify non Matches
For i = 1 To UBound(var)
If Not dic.exists(var(i, 1)) Then
n = n + 1
ar1(n, 1) = var(i, 1)
End If
Next i

'Output Results Remove any Duplication
Sheet1.Range("E10:E" & UBound(var)).Value = ar1
Range("E10:E" & UBound(var)).RemoveDuplicates 1

End Sub



thank you so much in advance.
 

Attachments

  • Worksheet1.PNG
    Worksheet1.PNG
    94.1 KB · Views: 12
  • Worksheet2.PNG
    Worksheet2.PNG
    91.4 KB · Views: 11
  • Worksheet3.PNG
    Worksheet3.PNG
    104.3 KB · Views: 13

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Try
VBA Code:
Sub kfg()
'Excel vba to remove duplicates.
   
   Dim dic As Object
   Dim ar As Variant
   Dim ar1 As Variant
   Dim var As Variant
   Dim i As Long
   Dim n As Long
   
   Set dic = CreateObject("Scripting.Dictionary")
   dic.CompareMode = 1
   ar = Sheet2.Range("B2", Sheet2.Range("B" & Rows.Count).End(xlUp)).Value2
   var = Sheet3.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
   ReDim ar1(1 To UBound(var), 1 To 2)
   
   'Loop through ar and add to Dictionary.
   For i = 1 To UBound(ar)
      dic(ar(i, 1)) = Empty
   Next i
   
   'Identify non Matches
   For i = 1 To UBound(var)
      If Not dic.Exists(var(i, 1)) Then
         n = n + 1
         ar1(n, 1) = var(i, 1)
         ar1(n, 2) = var(i, 2)
      End If
   Next i
   
   'Output Results Remove any Duplication
   Sheet1.Range("E10").Resize(n, 2).Value = ar1
   Sheet1.Range("E10").Resize(n, 2).RemoveDuplicates 1

End Sub
 
Upvote 0
Solution
Try
VBA Code:
Sub kfg()
'Excel vba to remove duplicates.
  
   Dim dic As Object
   Dim ar As Variant
   Dim ar1 As Variant
   Dim var As Variant
   Dim i As Long
   Dim n As Long
  
   Set dic = CreateObject("Scripting.Dictionary")
   dic.CompareMode = 1
   ar = Sheet2.Range("B2", Sheet2.Range("B" & Rows.Count).End(xlUp)).Value2
   var = Sheet3.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
   ReDim ar1(1 To UBound(var), 1 To 2)
  
   'Loop through ar and add to Dictionary.
   For i = 1 To UBound(ar)
      dic(ar(i, 1)) = Empty
   Next i
  
   'Identify non Matches
   For i = 1 To UBound(var)
      If Not dic.Exists(var(i, 1)) Then
         n = n + 1
         ar1(n, 1) = var(i, 1)
         ar1(n, 2) = var(i, 2)
      End If
   Next i
  
   'Output Results Remove any Duplication
   Sheet1.Range("E10").Resize(n, 2).Value = ar1
   Sheet1.Range("E10").Resize(n, 2).RemoveDuplicates 1

End Sub
That worked. thank you. But question, how would the code look like if i wanted the same scenerio , but added in Worksheet4? So compare worksheet 2 , 3 , and 4. and out put it to worksheet 1?

thank you so so much.
 

Attachments

  • Worksheet1.PNG
    Worksheet1.PNG
    94.1 KB · Views: 8
  • Worksheet2.PNG
    Worksheet2.PNG
    91.4 KB · Views: 7
  • Worksheet3.PNG
    Worksheet3.PNG
    104.3 KB · Views: 9
  • Worksheet4.PNG
    Worksheet4.PNG
    82.9 KB · Views: 8
Upvote 0
In what way should they be compared?
 
Upvote 0
In what way should they be compared?
compare worksheet 2, 3, 4, and outputs which ip addresses are not in worksheet 2 and puts the results to worksheet 1. the output should have "model" column associated with the ip address result.

i really appreciate your response. I am passively learning .
 
Upvote 0
Ok, how about
VBA Code:
Sub kfg()
'Excel vba to remove duplicates.
   
   Dim dic As Object
   Dim ar As Variant
   Dim ar1 As Variant
   Dim var As Variant, var1 As Variant
   Dim i As Long
   Dim n As Long
   
   Set dic = CreateObject("Scripting.Dictionary")
   dic.CompareMode = 1
   ar = Sheet2.Range("B2", Sheet2.Range("B" & Rows.Count).End(xlUp)).Value2
   var = Sheet3.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
   var1 = Sheet4.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
   ReDim ar1(1 To UBound(var) + UBound(var1), 1 To 2)
   
   'Loop through ar and add to Dictionary.
   For i = 1 To UBound(ar)
      dic(ar(i, 1)) = Empty
   Next i
   
   'Identify non Matches
   For i = 1 To UBound(var)
      If Not dic.Exists(var(i, 1)) Then
         n = n + 1
         ar1(n, 1) = var(i, 1)
         ar1(n, 2) = var(i, 2)
      End If
   Next i
   For i = 1 To UBound(var1)
      If Not dic.Exists(var1(i, 1)) Then
         n = n + 1
         ar1(n, 1) = var1(i, 1)
         ar1(n, 2) = var1(i, 2)
      End If
   Next i
   
   'Output Results Remove any Duplication
   Sheet1.Range("E10").Resize(n, 2).Value = ar1
   Sheet1.Range("E10").Resize(n, 2).RemoveDuplicates 1

End Sub
 
Upvote 0
Error : out of range

highlights : var1 = Sheet4.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
 
Upvote 0
Oops forgot to change the 2nd sheet3 to sheet4. If you change that it should be ok.
 
Upvote 0
Error : out of range

highlights : var1 = Sheet4.Range("C3", Sheet3.Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value2
Changed to : var1 = Sheet4.Range("D2", Sheet4.Range("D" & Rows.Count).End(xlUp)).Resize(, 2).Value2

outputs the "ip address" successfully , but does not output the "model"
 

Attachments

  • Worksheet1B.PNG
    Worksheet1B.PNG
    37.2 KB · Views: 7
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,268
Members
448,558
Latest member
aivin

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