Can somebody tell me why this won't work as explained...

[chazrab]

A sheet named "TEST" has the following:

  COL A          COL B          COL C    COL D

Description 	Category	Date	Amount

McDonalds        Food	       1/1/2009	$10.00 
KFC              Food	       1/3/2009	$5.00 
Mr. Cleaners     Cleaners      1/5/2009	$3.00 
Kroger	         Food          1/7/2009	$7.00 
Hollywood Video	 Movies        1/9/2009	$14.00

This code is supposed to find all values in COL B of "Food"(or any value from a Userform ComboBox) that are between two dates, Startdate = "01/01/2009" and Endate = "01/09/2009" and put them on a sheet named REPORT as follows:

COPIED TO "REPORT" SHEET:

McDonalds        Food	       1/1/2009	$10.00 
KFC              Food	       1/3/2009	$5.00 
Kroger	         Food          1/7/2009	$7.00

...but it doesn't. The code runs with no errors, but the REPORT sheet is blank. Can anyone tell me why?

Here is the code:

Private Sub CommandButton2_Click()
Dim _
Searchval               As String, _
dtmStart                As Date, _
dtmEnd                  As Date, _
RCell                   As Range, _
curTotal                As Currency
Dim wx                  As Worksheet
    Searchval = MrExcelForm.ComboBox1.Value
    dtmStart = Me.TextBox1.Value
    dtmEnd = Me.TextBox2.Value
    
    For Each RCell In Worksheets("TEST").Range("B1:B9")
        If RCell.Value = Searchval _
        And RCell.Offset(0, 1).Value >= dtmStart _
        And RCell.Offset(0, 1).Value <= dtmEnd Then
        End If
        'the following should place each row between the date values on the sheet "REPORT"
        'but the "REPORT" sheet is blank
        Set wx = Worksheets("REPORT")
        lRow = wx.Cells(Rows.Count, 1) _
        .End(xlUp).Offset(1, 0).Row
        With wx
        Dim d, c, da, a, v
        d = ActiveCell.Offset(0, 0).Value
        c = ActiveCell.Offset(0, 1).Value
        da = ActiveCell.Offset(0, 2).Value
        a = ActiveCell.Offset(0, 3).Value
        v = ActiveCell.Offset(0, 5).Value
        .Cells(lRow, 1).Value = d
        .Cells(lRow, 2).Value = c
        .Cells(lRow, 3).Value = da
        .Cells(lRow, 4).Value = a
        .Cells(lRow, 5).Value = v
        End With
     Next
     MsgBox "Here are the values =" & Searchval & dtmStart & dtmEnd
End Sub

Thanks for all your help.

CR

 

[jasonb75]

I'm no expert on this subject, but I'm thinking that your "with wx" block is taking the values for d,c,da,a & v from the empty cells in lRow instead of the test table.

Try moving the 6 lines from Dim d, c etc to v=Activecell out of the with block and inserting them above Set wx.

I'll have another look if that doesn't work, but to be honest I don't think my vb knowledge is up to it.

 

[Linde]

hello CHazrab,

I think your problem lies in your working order.
Your first Range RCell will be empty. Thenn your If statement is is probebly useles, after "Then" you are ending the IF statement. Wenn it would work all rows will be copied.

This would help I think. Try to ceep your VB script Simple.

Good Luck

Harm

 

[RoryA]

This is off the top of my head but try:

Private Sub CommandButton2_Click()
Dim Searchval               As String
Dim dtmStart                As Date, dtmEnd                  As Date
Dim RCell                   As Range
Dim curTotal                As Currency
Dim wx                  As Worksheet

Set wx = Worksheets("REPORT")
    Searchval = MrExcelForm.ComboBox1.Value
    dtmStart = CDate(Me.TextBox1.Value)
    dtmEnd = CDate(Me.TextBox2.Value)
    
    For Each RCell In Worksheets("TEST").Range("B1:B9")
        If RCell.Value = Searchval _
        And RCell.Offset(0, 1).Value >= dtmStart _
        And RCell.Offset(0, 1).Value <= dtmEnd Then
        'the following should place each row between the date values on the sheet "REPORT"
        'but the "REPORT" sheet is blank
        
        lRow = wx.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        wx.Cells(lRow, 1).Resize(, 5).Value = RCell.Offset(0,-1).resize(, 5).Value
End If
     Next RCell

     MsgBox "Here are the values =" & Searchval & dtmStart & dtmEnd
End Sub