VBA CODE EDITING - Search and Match and show the result

Vishaal

Active Member
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
 

DanteAmor

Well-known Member
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.
 

Vishaal

Active Member
Sure sir,
Can u pls confirm that code provided by u work for only A1:K9 or we can use it for bulk data
 

Vishaal

Active Member
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
 

DanteAmor

Well-known Member
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
 

Vishaal

Active Member
Thanks Dante Amor Ji

For your help and providing a very good code

Its make my work easy

Thanks
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top