Tricky macro help needed from a VBA pro

[JRS]

I asked for help earlier and have had some help which gets me most of the way there. The problem is its very different coding to what I have ever previously used so I cant make the last few tweaks to debug it.
Can someone help out please...

The original problem was:

I need the macro to:

1. Take todays date from F3 (of current "report" sheet)
2. go to "tables" sheet

3. Scan column B to find the most recent date to todays date,
4. take values from cell D and E (from the row selected in step 3) and put them both into cell P45 of the "report" sheet. ("xxx" & "yyy" into one cell)
5. Go back to the "tables" sheet (and to the same row as found in step 3), copy value of Cell "AP" into Cell P46 of the "report" sheet

6. return to "tables" sheet, move up 1 row from step 3
7. similar to step 4 except paste into O45 (of "report" sheet)
8. similar to step 5 except paste into O46 (of "report" sheet)

9. Repeat steps 6,7,8 another 3 times, each time pasting values into the previous column of the "report" sheet


The proposed solution was:

Sub DoReport()
Dim wsRpt As Worksheet
Dim wsTbls As Worksheet
Dim rngFnd As Range
Dim dt
Dim I As Long

Set wsRpt = Worksheets("Report")

Set wsTbls = Worksheets("Tables")

dt = wsRpt.Range("F3")

Do
Set rngFnd = wsTbls.Range("B:B").Find(dt)

If rngFnd Is Nothing Then dt = dt - 1

Loop Until Not rngFnd Is Nothing

If Not rngFnd Is Nothing Then

For I = 1 To 4

wsRpt.Range("P45").Offset(, 1 - I) = rngFnd.Offset(1 - I, 2) & rngFnd.Offset(1 - I, 3)
wsRpt.Range("P46").Offset(, 1 - I) = rngFnd.Offset(1 - I, 40)
Next I
End If

End Sub


I have tried it and it certainly is along the right lines. The first problem though, is that this code keeps picking the earliest date (at the top of the list) rather than the most recent date. So I think there is a problem with the line:

Set rngFnd = wsTbls.Range("B:B").Find(dt)

Does this compare the value in a cell in column B with value "dt" and then if it matches, set rngfnd to equal that cell location?
(not cell value, cell location)It needs to be location as later in the code we start offsetting from rngfnd

Please help, I need to try to get this sorted asap.
cheers.
JRS

 

[JRS]

I've got loads of other macros that I dont really wanna start uploading, they link to loads and loads of other documents. is there a way of just uploading the worksheets without any of the macros?

 

[Norie]

Why not just create a stripped down version with the relevant worksheets and just the code of interest?

Copying the worksheets would be quite straightforward by hand or using code.

Worksheets("Report", "Table").Copy

Then just copy the code into the newly created workbook, save it, upload it and post a link.

 

[JRS]

http://wtrns.fr/enY5zwYCqsI5Jp


theres the link, they are saved as 2 seperate spreadsheets in a zip file, sure you'll be able to open it ok and stick them into one workbook
Let me know if you find a solution, been trying to do this for about 10 hours now, its totally killing me. You will need to use your own macro's cos I think everything was stripped away although im not sure,
cheers
JRS

 

[Norie]

JRS

Can't you just copy the 2 relevant worksheets to a new workbook?

All you need to do is select theittabs and the right click Copy or Move... and select (new workbook).

Then copy the code into the new workbook.

It'd be far easier to work with one workbook than having to reconstruct one.

Reconstructing it might not even help very much - something could be lost and that something could be to do with the problem.

 

[Norie]

Sorry, but have you being taking the mickey?

There is no date in F3, the date is in F2 and the dates start in row 4 on the tables worksheet, something you didn't mention.

I changed 2 numbers and the code works - the numbers I changed were 3 and 2.

Try changing them and see if the code works.

 

[JRS]

No, not been taking the mickey... I changed F3 to F2 a few hours ago and have been changing the code I've been using ever since to match that.

As for the data not starting until row 4, I did mention it but either way I didnt think that would stop it working?

Its still not working here, can you copy and paste me the full code your using?

Cheers, apologies if it seems like im being an idiot but something definitely isnt working here.

 

[Norie]

It definitely would make a difference where the dates started.

The loop was starting at B2, which is empty and is why you get the type mismatch error.

The only mention I can recall of B4 is this in post #9:

02/01/2011 found in cell B4

Also if you are going to change the code post that code.

I'll post the code, it's exactly the same apart from 2 numbers being changed.

Option Explicit
 
Sub DoReport()
Dim wsRpt As Worksheet
Dim wsTbls As Worksheet
Dim rngDt As Range
Dim rngFnd As Range
Dim I As Long
Dim LastRow As Long
 
    Set wsRpt = Worksheets("Report")
 
    Set rngDt = wsRpt.Range("F2")
 
    Set wsTbls = Worksheets("Tables")
 
    LastRow = wsTbls.Range("B" & Rows.Count).End(xlUp).Row
 
    For I = 4 To LastRow
        If DateValue(wsTbls.Range("B" & I).Value) <= DateValue(rngDt.Value) Then
            Set rngFnd = wsTbls.Range("B" & I)
        End If
    Next I
 
    If Not rngFnd Is Nothing Then
        For I = 1 To 4
            wsRpt.Range("P45").Offset(, 1 - I) = rngFnd.Offset(1 - I, 2) & rngFnd.Offset(1 - I, 3)
            wsRpt.Range("P46").Offset(, 1 - I) = rngFnd.Offset(1 - I, 40)
        Next I
    End If
 
End Sub

 

[JRS]

What can I say... its working like a dream!
Thanks so much for helping out, I was correctly changing the F3 to F2 but hadnt been changing it to row 4.

Absolute life saver, gutted I've been stuck on this for so long when its such a simple fix.
Cheers!

:D