Unlucky-Phase
New Member
- Joined
- Sep 23, 2019
- Messages
- 14
Hello,
I currently have a workbook with multiple sheets and they all have the same table in them. But each table contains different information with different expiry dates. I'm trying to look for the info with an expiry date that matches 'my keydate' and paste it into the front page. There could be up to 15 different lines so obviously want them pasted consecutively. I'm having a couple issues, first is that I can only use one key date, whereas I'd like a range if possible (7 consecutive dates). If I put multiple key dates using OR it pulls the headers from each table and can be a little slow.
Also, it's pasting into the table 2 rows below the headers. I tried moving it up, but then it fails to find the last line which if why I've had to set a resize range and a clear contents. Here's my VBA code below:
Any help to optimise would be appreciated!
Thanks,
Molly
I currently have a workbook with multiple sheets and they all have the same table in them. But each table contains different information with different expiry dates. I'm trying to look for the info with an expiry date that matches 'my keydate' and paste it into the front page. There could be up to 15 different lines so obviously want them pasted consecutively. I'm having a couple issues, first is that I can only use one key date, whereas I'd like a range if possible (7 consecutive dates). If I put multiple key dates using OR it pulls the headers from each table and can be a little slow.
Also, it's pasting into the table 2 rows below the headers. I tried moving it up, but then it fails to find the last line which if why I've had to set a resize range and a clear contents. Here's my VBA code below:
VBA Code:
Sub FindData()
totalsheets = Worksheets.Count
mykeyword = Worksheets("Front Page").Cells(7, 2).Value
Worksheets("Front Page").Range("D8:N500").ClearContents
Set objListObj = Worksheets("Front Page").ListObjects(1)
objListObj.Resize Range("D7:N9")
For i = 1 To totalsheets
If Worksheets(i).Name <> "Front Page" Then
lastrow = Worksheets(i).Cells(Rows.Count, 4).End(xlUp).Row
For j = 1 To lastrow
If Worksheets(i).Cells(j, 11).Value = mykeyword Then
Worksheets("Front Page").Activate
LastRow2 = Worksheets("Front Page").Cells(Rows.Count, 4).End(xlUp).Row + 1
Worksheets("Front Page").Cells(LastRow2, 4).Value = Worksheets(i).Cells(j, 4).Value
Worksheets("Front Page").Cells(LastRow2, 5).Value = Worksheets(i).Cells(j, 5).Value
Worksheets("Front Page").Cells(LastRow2, 6).Value = Worksheets(i).Cells(j, 6).Value
Worksheets("Front Page").Cells(LastRow2, 7).Value = Worksheets(i).Cells(j, 7).Value
Worksheets("Front Page").Cells(LastRow2, 8).Value = Worksheets(i).Cells(j, 8).Value
Worksheets("Front Page").Cells(LastRow2, 9).Value = Worksheets(i).Cells(j, 9).Value
Worksheets("Front Page").Cells(LastRow2, 10).Value = Worksheets(i).Cells(j, 10).Value
Worksheets("Front Page").Cells(LastRow2, 11).Value = Worksheets(i).Cells(j, 11).Value
Worksheets("Front Page").Cells(LastRow2, 12).Value = Worksheets(i).Cells(j, 12).Value
Worksheets("Front Page").Cells(LastRow2, 13).Value = Worksheets(i).Cells(j, 13).Value
Worksheets("Front Page").Cells(LastRow2, 14).Value = Worksheets(i).Cells(j, 14).Value
End If
Next
End If
Next
End Sub
Any help to optimise would be appreciated!
Thanks,
Molly