Tricky macro help needed from a VBA pro

JRS

New Member
Joined
Mar 10, 2011
Messages
44
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
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

JRS

New Member
Joined
Mar 10, 2011
Messages
44
Hmmm, well then I'm struggling to see why the date isnt being found correctly.

Does it check the whole of column B, and does it check for an exact match? or is it possible that its just looking for a close match?

The only other thing I can think of is that its not happy with subtracting 1 from the date that is fed into dt.

Any ideas?
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Find can be tricky with dates. What happens if you?

Dim dt As Date

Also you could try:

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

JRS

New Member
Joined
Mar 10, 2011
Messages
44

ADVERTISEMENT

When I tried DIM dt As Date
I got an error that said:
Invalid procedure call or argument
then highlights the line:
Set rngFnd = wsTbls.Range("B:B").Find(dt)


Using:
Set rngFnd = wsTbls.Range("B:B").Find(CLng(dt))
made it do the same as the original code, find the first date in the column, but it took a bit longer to do it.

The main good news I have seen is that the rest of the code works fine, it does all the offset stuff perfectly. Its just this finding the right date at the beginning which is a problem. Anymore ideas?

Cheers for the help so far!...
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
What date do you have in F3 on worksheet "Report" and what is its number format? Also please provide some sample dates from column B on worksheet "Tables".
 

JRS

New Member
Joined
Mar 10, 2011
Messages
44

ADVERTISEMENT

Date in F3 on "Report" is:
=TODAY()
it is correctly displaying todays date.
The format it is in is:

"Date
3/14/1998"
(according to the formating options)

Sample dates from column B:

<TABLE style="WIDTH: 52pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=69 border=0 x:str><COLGROUP><COL style="WIDTH: 52pt; mso-width-source: userset; mso-width-alt: 2523" width=69><TBODY><TR style="HEIGHT: 13.5pt" height=18><TD class=xl66 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: windowtext 1pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 52pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" width=69 height=18 x:num="40545">02-Jan-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40552" x:fmla="=A1+7">09-Jan-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40559" x:fmla="=A2+7">16-Jan-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40566" x:fmla="=A3+7">23-Jan-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl65 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40573" x:fmla="=A4+7">30-Jan-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl66 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40580" x:fmla="=A5+7">06-Feb-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40587" x:fmla="=A6+7">13-Feb-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40594" x:fmla="=A7+7">20-Feb-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl65 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40601" x:fmla="=A8+7">27-Feb-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl66 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40608" x:fmla="=A9+7">06-Mar-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40615" x:fmla="=A10+7">13-Mar-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40622" x:fmla="=A11+7">20-Mar-11</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD class=xl65 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 13.5pt; BACKGROUND-COLOR: white" height=18 x:num="40629" x:fmla="=A12+7">27-Mar-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl66 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40636" x:fmla="=A13+7">03-Apr-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40643" x:fmla="=A14+7">10-Apr-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40650" x:fmla="=A15+7">17-Apr-11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: white" height=17 x:num="40657" x:fmla="=A16+7">24-Apr-11</TD></TR></TBODY></TABLE>



I just tried changing them to the exact same date format but no luck. It just did exactly the same thing as befor.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Does this work for you?

Code:
Sub Test()
    Dim wsRpt As Worksheet
    Dim wsTbls As Worksheet
    Dim rngFnd As Range
    Dim dt As Date
    Dim I As Long
    Set wsRpt = Worksheets("Report")
    Set wsTbls = Worksheets("Tables")
    dt = wsRpt.Range("F3")
    Do
        Set rngFnd = wsTbls.Range("B:B").Find(What:=dt, LookIn:=xlFormulas, Lookat:=xlWhole)
        If rngFnd Is Nothing Then dt = dt - 1
    Loop While rngFnd Is Nothing
    If Not rngFnd Is Nothing Then
        MsgBox dt & " found in cell " & rngFnd.Address(False, False)
    End If
End Sub

It did for me in Excel 2003 (20 Mar 2011 in B12).
 

JRS

New Member
Joined
Mar 10, 2011
Messages
44
I get a message box saying:

02/01/2011 found in cell B4
(the top 3 cells of the spreadsheet are frozen as they are part of the title of the page)

So I'm trying to get it to:
20/03/2011 found in cell B15
 

Watch MrExcel Video

Forum statistics

Threads
1,122,484
Messages
5,596,407
Members
414,064
Latest member
Duncthegreat

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top