Query & Write

  • Thread starter Thread starter Michael168
  • Start date Start date
M

Michael168

Datasheet contains
Row 1( Header)----> Date Na Nb Nc Nd
Row 2 31/10/03 1 8 3 4
Row 3 01/11/03 5 8 2 9

Querysheet contains
Row 1(Header)----> Date Rowno 1 3 5 6 9
Row 2 31/10/03 2 0 0 1 0 1

Query conditions are:
Look in the datasheet at row2 for a value of 1, if found, then look at
next row i.e. row3 for value found in the querysheet in this case are
1,3,5,6,9 . If found, it will write the date & rowno of row2 of
datasheet and the value of 1 & 0 will be insert accordingly to the
column.
This macro will run the loops from row2 of datasheet until the last
row.
Thank you for helping.
 
Michael

Try this

Sub QrySheet()

Dim DSh As Worksheet
Dim QSh As Worksheet
Dim i As Long, k As Long
Dim cell As Range
Dim Rng As Range
Dim MtchFnd As Variant

With ThisWorkbook
Set DSh = .Worksheets("Datasheet")
Set QSh = .Worksheets("Querysheet")
End With

Set Rng = DSh.Range("a2", DSh.Range("A65536").End(xlUp))
k = 1

For Each cell In Rng
If InStr("," & cell.Offset(0, 1).Value & _
"," & cell.Offset(0, 2).Value & _
"," & cell.Offset(0, 3).Value & _
"," & cell.Offset(0, 4).Value & ",", ",1,") > 0 Then

k = k + 1
QSh.Cells(k, 1).Value = cell.Value
QSh.Cells(k, 2).Value = cell.Row
QSh.Range("C" & k & ":G" & k).Value = 0

For i = 1 To 4
MtchFnd = Application.Match(cell.Offset(1, i).Value, _
QSh.Range("c1:G1"), False)

If Not IsError(MtchFnd) Then
QSh.Range("b" & k).Offset(0, MtchFnd).Value = 1
End If
Next i
End If
Next cell

End Sub
 
Back
Top