searching for data in columns with the same argument

[sjoerd.bosch]

Hello.
I am trying to copy/paste data from 2 columns (containing several rows with required data) and transfer the columns to another worksheet in the workbook
over a time span of either 23-24-or 25 hrs
The problem is that I need to use an argument what is not consistent and I have a macro in the workbook what adds a column at the end each time I enter new data.

In the attached I have the source sheet, which is here called "report"and the destination sheet, what is called "for technical report"

In row 6 there are mentioned occasions - which are named in the cell as: noon, eosp, sosp, departure, arrival and some others, which are not important
As said, when I update the daily reports - there is a column added at the end. Thus every day and every occasion a column is added in the sheet "reports'.

What I am looking to do is the following:
Copy / Paste the LAST Noon report and the previous (before the LAST) Noon report to a new column in another sheet, so that I have in the new columns the data in the columns of the last - either 23/24/25 hours (depends if we shift time when travelling East or West). If I have that data in another sheet, i can extract the data what I need on a daily basis.
It doesn't have to contain formulae. Just the data is sufficient
I have tried all sorts, both with macros and the build in formulas, but I am getting nowhere.
Hope you can assist

 

[JLGWhiz]

This might do it

Sub t2()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, adr As String, col1 As Long, col2 As Long
Set sh1 = Sheets("Report")
Set sh2 = Sheets("for technical report")
Set fn = sh1.Rows(6).Find("Noon", Cells(6, Columns.Count), xlValues, xlWhole, , xlPrevious)
    If Not fn Is Nothing Then
    adr = fn.Address
    x = 2
    Do
        sh2.Columns(x) = sh1.Columns(fn.Column).Value
        Set fn = Rows(6).FindPrevious(fn)
        x = x - 1
    Loop While x <> 0
    End If
End Sub

 

[sjoerd.bosch]

Almost. That code copies the every first noon report in the columns way back in 2018 when inserted into the original reporting workbook (all the records are added to the end of any existing records).
Therefore we have many noon messages from before and many to come. The above code copies the very first. I only need the last and the one before last.

 

[JLGWhiz]

I am not getting that kind of result. On my test set up it only brought over the last two Noon entries on row 6.

Here is the "Report" Sheet I use.

TestBase.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	x	x	x	x	x	x	x	x	x	x	x	x	x	x
2	x	x	x	x	x	x	x	x	x	x	x	x	x	x
3	x	x	x	x	x	x	x	x	x	x	x	x	x	x
4	x	x	x	x	x	x	x	x	x	x	x	x	x	x
5	x	x	x	x	x	x	x	x	x	x	x	x	x	x
6	fjeing	Noon	fkjeoi	gjkep	Noon	ddkjwpo	mndoiep	dklw	Noon	dkjesd	dklep;f	dkgf	Noon	doieps
7	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
8	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
9	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
10	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
11	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
12	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
13	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
14	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
15	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
16	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
17	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
18	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
19	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
20	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
21	dfg	a	sdfgw	erf	b	dee	erswg	erete	previous	xsdd	erfs	esffs	Last	gehe
Report

And Here is the other sheet with the results.

TestBase.xlsm
	A	B
1	x	x
2	x	x
3	x	x
4	x	x
5	x	x
6	Noon	Noon
7	previous	Last
8	previous	Last
9	previous	Last
10	previous	Last
11	previous	Last
12	previous	Last
13	previous	Last
14	previous	Last
15	previous	Last
16	previous	Last
17	previous	Last
18	previous	Last
19	previous	Last
20	previous	Last
21	previous	Last
for technical report

 

[JLGWhiz]

it just occurred to me that you might have archived Columns of data on the same worksheet somewhere to the right of your current report data, in which case this line

Set fn = sh1.Rows(6).Find("Noon", Cells(6, Columns.Count), xlValues, xlWhole, , xlPrevious)

Would definitely find your old data because it goes all the way to the end of row 6 and works back to the left to find the first 'Noon' entry. So if you can describe to me where the archived data begins, including any other data that may be entered on row 6 to the right of the current data, I can fix the code so it only evaluates current data.

 

[sjoerd.bosch]

Hi. this is how it looks on my end.
Funny thing is - I just tried the code on a clean sheet and it works
When I insert it in a new module in my workbook, it copies the very 1st column and the last one.
The 1st column should actually also be there [preferably], but main thing is the 2 Noon reports, so that I can use it for a final message sheet.
Is there a way to send you my complete workbook?

 

[JLGWhiz]

Let's try this rivised code. It attempts to use the current date as a marker for finding the last Noon entry. If your dates in row 4 are date data types formatted as 5.9.2020 then it should work.
However if the dates are just a manual input and not date data type, it will fail.

Sub t4()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, x As Long, col As Long
Set sh1 = Sheets("Report")
Set sh2 = Sheets("for technical report")
Set fn = sh1.Rows(4).Find(Date, sh1.Cells(4, Columns.Count), xlValues, xlPart, , xlPrevious)
    If Not fn Is Nothing Then
        col = fn.Offset(, 1).Column
    Else
        MsgBox "Date Not Found, Correction Needed." & vbLf & "Procedure will Terminate!", vbCritical, "NO DATE"
        Exit Sub
    End If
Set fn = Nothing
Set fn = sh1.Rows(6).Find("Noon", sh1.Cells(6, col), xlValues, xlWhole, , xlPrevious)
    If Not fn Is Nothing Then
    x = 2
        Do
            sh2.Columns(x) = sh1.Columns(fn.Column).Value
            Set fn = sh1.Rows(6).FindPrevious(fn)
            x = x - 1
        Loop While x <> 0
    End If
End Sub

 

[sjoerd.bosch]

the dates are in the format dd/mm/yyyy hh:mm and the code is not working
if you send me a mail, I can send the workbook - master.tankerselasse@gmail.com

 

[JLGWhiz]

I don't accept direct email attachments. I only respond to issues on the forum.
If there are blank columns after the columns you are showing in you screen shots, then this code should work. The only problem I am having with the code is finding a starting point to search for the word "Noon". I did not expect that there would be columns of old data off to the right of your current data. That was not specified in the OP. If the Date method won't work then this would be the only other way to get there without doing a lot of looping, which would take longer to run.

Sub t5()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, x As Long, col As Long
Set sh1 = Sheets("Report")
Set sh2 = Sheets("for technical report")
col = sh1.Cells(6, 1).End(xlToRight).Column + 1
Set fn = sh1.Rows(6).Find("Noon", sh1.Cells(6, col), xlValues, xlWhole, , xlPrevious)
    If Not fn Is Nothing Then
    x = 2
        Do
            sh2.Columns(x) = sh1.Columns(fn.Column).Value
            Set fn = sh1.Rows(6).FindPrevious(fn)
            x = x - 1
        Loop While x <> 0
    End If
End Sub

 

[JLGWhiz]

I also tweaked the one using the Date to find a starting point, and it seems to now be working.

Sub t4()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, x As Long, col As Long
Set sh1 = Sheets("Report")
Set sh2 = Sheets("for technical report")
Set fn = sh1.Rows(4).Find(Format(Date, "d.m.yyyy"), sh1.Cells(4, Columns.Count), xlValues, xlPart, , xlPrevious)
    If Not fn Is Nothing Then
        col = fn.Offset(, 1).Column
    Else
        MsgBox "Date Not Found, Correction Needed." & vbLf & "Procedure will Terminate!", vbCritical, "NO DATE"
        Exit Sub
    End If
Set fn = Nothing
Set fn = sh1.Rows(6).Find("Noon", sh1.Cells(6, col), xlValues, xlWhole, , xlPrevious)
    If Not fn Is Nothing Then
    x = 2
        Do
            sh2.Columns(x) = sh1.Columns(fn.Column).Value
            Set fn = sh1.Rows(6).FindPrevious(fn)
            x = x - 1
        Loop While x <> 0
    End If
End Sub

 

[sjoerd.bosch]

Hi. < I don't accept direct email attachments. I only respond to issues on the forum > Oh okay. understand. Sorry that I asked. It is sometimes a little diffivult to explain.
But that code actually works perfect. It copies and pastes the columns I want into the 1st two columns of the daily sheet.
One more question - What if I want to keep some original data in the 1st column of the daily sheet and the noon reports in the 2nd and 3rd column?