basic help please...

[PhilKib]

I've been struggling with this for sometime and can't find the answer.

I have a range of data in my Reference sheet, which holds specific information on certain members of a club, I then want to loop through each entry starting at A3 and compare it against the Data sheet which holds all information of all members. If the reference file entry is not found on the data sheet I want to miss that out but continue searching through the last of the reference file. So for example the reference file has A3:A20 at A10, for example, that person's name is not found in the datasheet I then want to continue searching through. Please see the code I have so far.
also... if there is a more elegant way of doing this then all ears!!

Sub myReportaa()

Dim dSheet As Worksheet
Dim rptSheet As Worksheet
Dim refSheet As Worksheet
Dim custname As Variant

Set dSheet = ThisWorkbook.Sheets("Data")
Set rptSheet = ThisWorkbook.Sheets("Report")
Set refSheet = ThisWorkbook.Sheets("Reference")
rptLR = rptSheet.Cells(Rows.Count, 1).End(xlUp).Row
rptSheet.Range("a2:g" & rptLR).ClearContents
lastrow = dSheet.Cells(Rows.Count, 1).End(xlUp).Row

y = 2 'starting row

x = 3

  
    custname = refSheet.Cells(x, 1)
   
    Do
     rptSheet.Cells(y, 1) = dSheet.Cells(x, 1)
     rptSheet.Cells(y, 2) = dSheet.Cells(x, 2)
     rptSheet.Cells(y, 3) = dSheet.Cells(x, 4)
     rptSheet.Cells(y, 4) = dSheet.Cells(x, 16)
     rptSheet.Cells(y, 5) = dSheet.Cells(x, 18)
     rptSheet.Cells(y, 6) = dSheet.Cells(x, 19)
     rptSheet.Cells(y, 7) = dSheet.Cells(x, 20)
     y = y + 1
     x = x + 1
     custname = refSheet.Cells(x, 1)
   
    Loop While dSheet.Cells(x, 2) = custname
  
rptSheet.Range ("A1")
End Sub

 

[footoo]

Try this (untested) :

Sub myReportaa()
Dim dSheet As Worksheet, rptSheet As Worksheet
Dim refSheet As Worksheet, cel As Range, custname As Range, y%

Set dSheet = ThisWorkbook.Sheets("Data")
Set rptSheet = ThisWorkbook.Sheets("Report")
Set refSheet = ThisWorkbook.Sheets("Reference")

rptSheet.Cells.ClearContents

y = 2
For Each cel In refSheet.Range("A3:A" & Cells(Rows.Count, "A").End(3).Row)
    Set custname = dSheet.[A:A].Find(cel)
    If Not custname Is Nothing Then
        rptSheet.Cells(y, 1).Resize(, 20) = custname.Resize(, 20).Value
        y = y + 1
    End If
Next
rptSheet.Range("C:C, E:O, Q:Q").Delete
End Sub

 

[PhilKib]

Try this (untested) :

Sub myReportaa()
Dim dSheet As Worksheet, rptSheet As Worksheet
Dim refSheet As Worksheet, cel As Range, custname As Range, y%

Set dSheet = ThisWorkbook.Sheets("Data")
Set rptSheet = ThisWorkbook.Sheets("Report")
Set refSheet = ThisWorkbook.Sheets("Reference")

rptSheet.Cells.ClearContents

y = 2
For Each cel In refSheet.Range("A3:A" & Cells(Rows.Count, "A").End(3).Row)
    Set custname = dSheet.[A:A].Find(cel)
    If Not custname Is Nothing Then
        rptSheet.Cells(y, 1).Resize(, 20) = custname.Resize(, 20).Value
        y = y + 1
    End If
Next
rptSheet.Range("C:C, E:O, Q:Q").Delete
End Sub

Hi FooToo

Thanks for replying this is certainly a lot neater than my attempt!, there is one thing though, I don't get anything in the Report Sheet,
Also, the variable custName doesn't appear to hold any name? or should that happen? also if you could be so kind, what does this line do;

rptSheet.Range("C:C, E:O, Q:Q").Delete (I just want to try to understand your code so that I learn as I go along.

Thanks Phil

 

[footoo]

Made some changes and added a few notes.
Post again if you need further explanation.

Sub myReportaa()
Dim dSheet As Worksheet, rptSheet As Worksheet
Dim refSheet As Worksheet, cel As Range, custname As Range, y%

Set dSheet = ThisWorkbook.Sheets("Data")
Set rptSheet = ThisWorkbook.Sheets("Report")
Set refSheet = ThisWorkbook.Sheets("Reference")

rptSheet.Range("A2:G" & Rows.Count).ClearContents

y = 2
'Loop thru names in col A of refSheet
For Each cel In refSheet.Range("A3:A" & refSheet.Cells(Rows.Count, "A").End(3).Row)
    'Find name on dSheet
    Set custname = dSheet.[A:A].Find(cel)
    'If name found
    If Not custname Is Nothing Then
        'Copy required columns from dSheet to rptSheet
        With rptSheet.Cells(y, 1)
            .Resize(, 2) = custname.Resize(, 2).Value
            .Offset(0, 2) = custname.Offset(0, 3).Value
            .Offset(0, 3) = custname.Offset(0, 15).Value
            .Offset(0, 4).Resize(, 3) = custname.Offset(0, 17).Resize(, 3).Value
        End With
        y = y + 1
    End If
Next
End Sub

 

[DanteAmor]

Here's another macro with another approach for you to consider

Sub Report_1()
  With Sheets("Report")
    .Cells.ClearContents
    Sheets("Data").Range("A1:T" & Sheets("Data").Range("A" & Rows.Count).End(3).Row).AdvancedFilter 2, _
      Sheets("Reference").Range("A2:A" & Sheets("Reference").Range("A" & Rows.Count).End(3).Row), .Range("A1")
    .Range("C:C, E:O, Q:Q").Delete
  End With
End Sub

The macro assumes that in row 1 of the "Data" sheet, you have the headings.

Dante Amor
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	HEAD1	HEAD2	HEAD3	HEAD4	HEAD5	HEAD6	HEAD7	HEAD8	HEAD9	HEAD10	HEAD11	HEAD12	HEAD13	HEAD14	HEAD15	HEAD16	HEAD17	HEAD18	HEAD19	HEAD20
2	A2	B2	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2	N2	O2	P2	Q2	R2	S2	T2
3	A3	B3	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3	N3	O3	P3	Q3	R3	S3	T3
4	A4	B4	C4	D4	E4	F4	G4	H4	I4	J4	K4	L4	M4	N4	O4	P4	Q4	R4	S4	T4
5	A5	B5	C5	D5	E5	F5	G5	H5	I5	J5	K5	L5	M5	N5	O5	P5	Q5	R5	S5	T5
6	A6	B6	C6	D6	E6	F6	G6	H6	I6	J6	K6	L6	M6	N6	O6	P6	Q6	R6	S6	T6
7	A7	B7	C7	D7	E7	F7	G7	H7	I7	J7	K7	L7	M7	N7	O7	P7	Q7	R7	S7	T7
Data

In the "Reference" sheet in cell A2 you must put the same heading that you have in cell A1 of the "Data" sheet

Dante Amor
	A
1
2	HEAD1
3	A2
4	A4
5	A51
6	A6
7
Reference

Result in "Report" sheet

Dante Amor
	A	B	C	D	E	F	G
1	HEAD1	HEAD2	HEAD4	HEAD16	HEAD18	HEAD19	HEAD20
2	A2	B2	D2	P2	R2	S2	T2
3	A4	B4	D4	P4	R4	S4	T4
4	A6	B6	D6	P6	R6	S6	T6
Report

 

[footoo]

The macro assumes that in row 1 of the "Data" sheet, you have the headings.

Based on post #1, the Data sheet data starts on row 3, so some adjustment may be necessary to DanteAmors macro to get the correct headings on the Reference sheet.
(Also, it is assumed that columns after col G on the Data sheet are not used.)

 

[DanteAmor]

the Data sheet data starts on row 3

You're right. Thanks for watching.
I put the updated macro to start at row 3.

Sub Report_1()
  With Sheets("Report")
    .Cells.ClearContents
    Sheets("Data").Range("A3:T" & Sheets("Data").Range("A" & Rows.Count).End(3).Row).AdvancedFilter 2, _
      Sheets("Reference").Range("A2:A" & Sheets("Reference").Range("A" & Rows.Count).End(3).Row), .Range("A1")
    .Range("C:C, E:O, Q:Q").Delete
  End With
End Sub

 

[PhilKib]

Thank you for your help with this one, your time is very much appreciated. I've ran this code and for the first time of execution it runs fine, however, if for any reason the reference file is changed i.e. a name added or subtracted, then the result in the Report sheet is just the header row with no other data shown. I must be doing something 'wrong' but can't figure it out!

 

[DanteAmor]

if for any reason the reference file is changed i.e. a name added or subtracted,

You can put the sample of the data when the macro doesn't work, use XL2BB tool, look at my signature.

 

[PhilKib]

hi, please see below.

workingfilter.xlsm
	F
14
Reference

workingfilter.xlsm
	A
1	JOHN LYNCH
2	ELAINE CARLIN & RICKY HARRISON
3	CHARLEY GRIFFIN
4	CAMERON EGGLESTON & FRASER EGGLESTON
5	DIONNE DOLAN
6	ANTONIO SANTANIELLO & ELENA TEPELIGA
7	ANDREW THOMSON
8	SHONA THOMSON & STEVEN WILSON
9	KIM MACDONALD
10	FRASER EGGLESTON
11	CRAIG NICOLL
12	Phil Kibble
13	CALLUM TAYLOR
14	LAUREN JOHNSTONE & CONNOR CARSON
15	DANIEL FOX
16	JORDAN CUSHNIE
17	PAUL MCKAY
18	LEANNE PERCIVAL
19	ALAN WATSON
20	MOHAMED HEGAZI & ALINA SOTIR
21	MARIA BRIEN
22	KENNETH DIAMOND & ELIZABETH DIAMOND
23	CAROLINE SMITH
24	PETER POLAND
Reference

workingfilter.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Internal No.	Name	Acs	Value	CurYr Acs	CurYr O/S Value	Dec	On Hold	BDets	EDets	ActIns	O/S Dil.	HC	Enq	Diary	L/Year	Band	Home Tel. No.	Oth. Tel. No.	Work Tel. No.
2	04020039369	IAN DAVIDSON & ALISON DAVIDSON	8	£10,472.63	0	£0.00	N	Y	Y	Y	N	N	N	N	N	2019
3	04020023376	ALBERT BRUCE & PAMELA BRUCE	10	£8,247.54	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2018
4	04020054701	ANGELA MORAN	17	£5,505.84	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
5	04020047936	SHAUN WILKIE & CAITLIN NICHOLSON	10	£5,088.42	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
6	04020020605	SHIRLEY KYLES & ALAN DRYSDALE	6	£4,865.64	0	£0.00	N	Y	Y	Y	N	Y	N	N	Y	2015
7	04020054709	WILLIAM MCKIMMIE	9	£4,248.73	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
8	04020050700	LYNZI SMITH & JAMES MCCABE	7	£3,317.21	0	£0.00	N	Y	N	Y	N	N	N	N	N	2019
9	04020053303	LISA POTTER	12	£3,134.51	0	£0.00	N	Y	N	N	N	N	N	N	N	2009
10	04020054719	AMEEN ILAHI	6	£2,858.57	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
11	04020045524	SHONA THOMSON	9	£2,741.51	0	£0.00	N	Y	Y	Y	N	N	N	N	N	2013
12	04020009635	PAUL CHRISTIE & CHERYL SINCLAIR	3	£2,480.06	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2017
13	04020040963	NEILL CONNOLLY	5	£2,404.28	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
14	04020040345	STEVEN MOIR & SAMANTHA MCCASH	2	£2,119.86	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
15	04020032208	CAMERON EGGLESTON	1	£2,041.50	0	£0.00	N	Y	N	N	N	N	N	N	Y	2018
16	04020046587	MARTIN GALLACHER	8	£2,009.61	0	£0.00	N	Y	N	Y	N	Y	N	N	N	2019
17	04020049738	RYAN WALLACE & STACY DUNCAN	5	£1,976.57	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
18	04020054732	JOHN LYNCH	11	£1,930.56	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
19	04020047371	ELAINE CARLIN & RICKY HARRISON	5	£1,533.05	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2017
20	04020044128	CHARLEY GRIFFIN	3	£1,521.69	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
21	04020041259	CAMERON EGGLESTON & FRASER EGGLESTON	1	£1,404.38	0	£0.00	N	Y	Y	N	N	N	N	N	Y	2019
22	04020050746	DIONNE DOLAN	5	£1,221.24	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
23	04020052711	ANTONIO SANTANIELLO & ELENA TEPELIGA	1	£1,112.75	0	£0.00	N	Y	Y	Y	N	N	N	N	Y	2019
24	04020054711	ANDREW THOMSON	2	£1,108.22	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
25	04020045527	SHONA THOMSON & STEVEN WILSON	2	£1,054.85	0	£0.00	N	Y	Y	Y	N	N	N	N	N	2019
26	04020054721	KIM MACDONALD	2	£1,028.26	0	£0.00	N	Y	N	N	N	N	N	N	N	2019
27	04020012695	FRASER EGGLESTON	2	£979.34	0	£0.00	N	Y	N	N	N	N	N	N	Y	2016
28	04020036475	CRAIG NICOLL	4	£817.82	0	£0.00	N	Y	Y	Y	N	Y	N	N	Y	2011
29	04020017395	CALLUM TAYLOR	2	£732.00	0	£0.00	N	Y	Y	N	N	N	N	N	Y	2018
30	04020022083	LAUREN JOHNSTONE & CONNOR CARSON	3	£727.57	0	£0.00	N	Y	Y	Y	N	N	N	N	N	2017
31	04020052511	DANIEL FOX	1	£723.30	0	£0.00	N	Y	N	Y	N	N	N	N	N	2019
Data