VBA CODE EDITING - Search and Match and show the result

Vishaal

Well-known Member
Joined
Mar 16, 2019
Messages
530
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
  2. Web
Hi all,

We are using the following VBA code

Code:
Sub Search_and_Match()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long, col As Long, lr2 As Long
  Dim c As Range, f As Range, r As Range
  '
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
  Set r = sh1.Range("H4", sh1.Cells(lr, lc))
  r.Offset(r.Rows.Count + 2).ClearContents
  For Each c In r
    If c.Value <> "" Then
      col = c.Column - r.Cells(1, 1).Column + 1
      Set f = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
      If Not f Is Nothing Then
        If f.Offset(, col).Value = "Yes" Then
          sh1.Cells(lr + 3, c.Column).Resize(2).Value = sh1.Cells(1, c.Column).Resize(2).Value
          lr2 = sh1.Cells(Rows.Count, c.Column).End(xlUp).Row + 1
          sh1.Cells(lr2, c.Column).Value = c.Value
        End If
      End If
    End If
  Next
End Sub

for the following sheets

Excel 2010 32 bit
A
B
C
D
E
F
G
H
I
J
K
1
S.No.​
Age Group​
Danial​
Chrix​
Rocky​
Ricky​
Danial​
Chrix​
Rocky​
Ricky​
2
Ronaldo​
Pamela​
Donald​
messy​
Ronaldo​
Pamela​
Donald​
messy​
3
4
1​
20​
Yes​
Na​
Yes​
Na​
5
2​
30​
Na​
Na​
Na​
Na​
6
3​
40​
Na​
Na​
Na​
Na​
2​
3​
7
4​
50​
Yes​
Yes​
Na​
Na​
4​
8
5​
60​
Yes​
Na​
Na​
Yes​
1​
9
6​
70​
Na​
Yes​
Na​
Yes​
1​
5​
Sheet: Sheet1

Second sheet for compare

Excel 2010 32 bit
A
B
C
D
E
1
S.No.​
Danial​
Chrix​
Rocky​
Ricky​
2
Ronaldo​
Pamela​
Donald​
messy​
3
4
1​
5
2​
6
3​
Yes​
7
4​
Yes​
Yes​
8
5​
Yes​
Yes​
9
6​
Sheet: Sheet2

Result Sheet

Excel 2010 32 bit
A
B
C
D
E
F
G
H
I
J
K
1
S.No.​
Age Group​
Danial​
Chrix​
Rocky​
Ricky​
Danial​
Chrix​
Rocky​
Ricky​
2
Ronaldo​
Pamela​
Donald​
messy​
Ronaldo​
Pamela​
Donald​
messy​
3
4
1​
20​
Yes​
Na​
Yes​
Na​
5
2​
30​
Na​
Na​
Na​
Na​
6
3​
40​
Na​
Na​
Na​
Na​
2​
3​
7
4​
50​
Yes​
Yes​
Na​
Na​
4​
8
5​
60​
Yes​
Na​
Na​
Yes​
1​
9
6​
70​
Na​
Yes​
Na​
Yes​
1​
5​
10
11
12
5​
4​
13
Rocky​
Ricky​
14
Donald​
messy​
Sheet: Sheet1


now my query is if we add three more rows data then for the result what modification required and in result sheet, result are starting from "row 12", can we start it after five/six/seven row from last filled coloumn

Excel 2010 32 bit
A
B
C
D
E
F
G
H
I
J
K
1
S.No.​
Age Group​
Danial​
Chrix​
Rocky​
Ricky​
Danial​
Chrix​
Rocky​
Ricky​
2
Ronaldo​
Pamela​
Donald​
messy​
Ronaldo​
Pamela​
Donald​
messy​
3
shika​
rghu​
randy​
john​
shika​
rghu​
randy​
john​
4
lovely​
rick​
flair​
prave​
lovely​
rick​
flair​
prave​
5
rinku​
mone​
rashmi​
peter​
rinku​
mone​
rashmi​
peter​
6
7
1​
20​
Yes​
Na​
Yes​
Na​
8
2​
30​
Na​
Na​
Na​
Na​
9
3​
40​
Na​
Na​
Na​
Na​
2​
3​
10
4​
50​
Yes​
Yes​
Na​
Na​
4​
11
5​
60​
Yes​
Na​
Na​
Yes​
1​
12
6​
70​
Na​
Yes​
Na​
Yes​
1​
5​
Sheet: Sheet1
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Try this

Code:
Sub Search_and_Match()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long, col As Long, lr2 As Long
  Dim c As Range, f As Range, r As Range
  '
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
  Set r = sh1.Range("H[COLOR=#ff0000][B]7[/B][/COLOR]", sh1.Cells(lr, lc))
  r.Offset(r.Rows.Count + 2).ClearContents
  For Each c In r
    If c.Value <> "" Then
      col = c.Column - r.Cells(1, 1).Column + 1
      Set f = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
      If Not f Is Nothing Then
        If f.Offset(, col).Value = "Yes" Then
          sh1.Cells(lr + 3, c.Column).Resize(2).Value = sh1.Cells(1, c.Column).Resize(2).Value
          lr2 = sh1.Cells(Rows.Count, c.Column).End(xlUp).Row + 1
          sh1.Cells(lr2, c.Column).Value = c.Value
        End If
      End If
    End If
  Next
End Sub

Try and tell me. If the result is different, then you can put the expected result.
 
Upvote 0
Sure sir,
Can u pls confirm that code provided by u work for only A1:K9 or we can use it for bulk data
 
Upvote 0
Thanks sir for the solution, pls check the details

First Sheet
Excel 2010 32 bit
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
1
Danial​
Chrix​
Rocky​
Ricky​
log​
ghun​
Danial​
Chrix​
Rocky​
Ricky​
log​
ghun​
2
Ronaldo​
Pamela​
Donald​
messy​
sanju​
safi​
Ronaldo​
Pamela​
Donald​
messy​
sanju​
safi​
3
shika​
rghu​
randy​
john​
vijju​
rodi​
shika​
rghu​
randy​
john​
vijju​
rodi​
4
lovely​
rick​
flair​
prave​
archi​
tina​
lovely​
rick​
flair​
prave​
archi​
tina​
5
rinku​
mone​
rashmi​
peter​
novit​
emli​
rinku​
mone​
rashmi​
peter​
novit​
emli​
6
7
8
1​
9
2​
17000​
700​
Na​
Na​
Na​
Na​
Na​
Na​
1​
1​
1​
1​
10
3​
83000​
300​
Na​
Na​
2​
2​
11
4​
92000​
200​
12
5​
42000​
200​
Na​
1​
13
6​
69000​
900​
Na​
Na​
1​
1​
14
7​
93000​
300​
Na​
15
8​
31000​
100​
Na​
Na​
Na​
16
9​
56000​
600​
Na​
Na​
Na​
Na​
Na​
1​
17
10​
58000​
800​
Na​
Na​
Na​
Na​
2​
4​
3​
3​
Sheet: Sheet1

Comparison Sheet
Excel 2010 32 bit
A
B
C
D
E
F
G
1
Danial​
Chrix​
Rocky​
Ricky​
log​
ghun​
2
Ronaldo​
Pamela​
Donald​
messy​
sanju​
safi​
3
shika​
rghu​
randy​
john​
vijju​
rodi​
4
lovely​
rick​
flair​
prave​
archi​
tina​
5
rinku​
mone​
rashmi​
peter​
novit​
emli​
6
7
8
1​
9
2​
Yes​
10
3​
Yes​
11
4​
Yes​
12
5​
Yes​
13
6​
Yes​
Yes​
14
7​
15
8​
Yes​
16
9​
17
10​
Yes​
18
11​
Yes​
Sheet: Sheet2

Result Sheet
Excel 2010 32 bit
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
1
Danial​
Chrix​
Rocky​
Ricky​
log​
ghun​
Danial​
Chrix​
Rocky​
Ricky​
log​
ghun​
2
Ronaldo​
Pamela​
Donald​
messy​
sanju​
safi​
Ronaldo​
Pamela​
Donald​
messy​
sanju​
safi​
3
shika​
rghu​
randy​
john​
vijju​
rodi​
shika​
rghu​
randy​
john​
vijju​
rodi​
4
lovely​
rick​
flair​
prave​
archi​
tina​
lovely​
rick​
flair​
prave​
archi​
tina​
5
rinku​
mone​
rashmi​
peter​
novit​
emli​
rinku​
mone​
rashmi​
peter​
novit​
emli​
6
7
8
1​
9
2​
17000​
700​
Na​
Na​
Na​
Na​
Na​
Na​
1​
1​
1​
1​
10
3​
83000​
300​
Na​
Na​
2​
2​
11
4​
92000​
200​
12
5​
42000​
200​
Na​
1​
13
6​
69000​
900​
Na​
Na​
1​
1​
14
7​
93000​
300​
Na​
15
8​
31000​
100​
Na​
Na​
Na​
16
9​
56000​
600​
Na​
Na​
Na​
Na​
Na​
1​
17
10​
58000​
800​
Na​
Na​
Na​
Na​
2​
4​
3​
3​
18
19
20
4​
3​
21
Chrix​
ghun​
22
Pamela​
safi​
23
rghu​
rodi​
24
rick​
tina​
25
mone​
emli​
Sheet: Sheet1

we have added some data but we have approx total rows 60 and column till IB

result always show after last row (gaping approx 4 to 5 row from last filled row)



in this sheet we will check only last filled row data i mean K17:P17 (For above sheet) to sheet 2
when we add data in K18:P18, code will check only K18:P18 now it will not check K17:P17

all the points are same as previous question, only added the above point
 
Upvote 0
Sorry, but I am not understanding how the data is growing.
Try the following, I hope it helps.

Code:
Sub Search_and_Match()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr As Long, lc As Long, col As Long, lr2 As Long
  Dim c As Range, f As Range, r As Range
  '
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
  Set r = sh1.Range("H7", sh1.Cells(lr, lc))
  r.Offset(r.Rows.Count + 2).ClearContents
  For Each c In r
    If c.Value <> "" Then
      col = c.Column - r.Cells(1, 1).Column + 1
      Set f = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
      If Not f Is Nothing Then
        If f.Offset(, col).Value = "Yes" Then
          sh1.Cells(lr + 3, c.Column).Resize([B][COLOR=#FF0000]5[/COLOR][/B]).Value = sh1.Cells(1, c.Column).Resize([B][COLOR=#ff0000]5[/COLOR][/B]).Value
          lr2 = sh1.Cells(Rows.Count, c.Column).End(xlUp).Row + 1
          sh1.Cells(lr2, c.Column).Value = c.Value
        End If
      End If
    End If
  Next
End Sub
 
Upvote 0
Thanks Dante Amor Ji

For your help and providing a very good code

Its make my work easy

Thanks
 
Upvote 0
I am really glad to know that it works for you. thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

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