help with vba code please

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have a form created in VBA. I have a txtbox1 = begin date and txtbox2 =
end date. On this form I also have an OK button

On worksheet "summary" I have rows of data by date. Date is in A4:A500.

I would like assistance is writing the code in the "OK" procedure that will
copy data from SUMMARY based on input date range(txtbox1 and txtbox2) and
paste into worksheet "results".

thank you
 
Try this and let me know if you have problems:
' Code written 8/24/2006 by CChickering for Mona

Sheets("summary").Range("A1").AutoFilter Field:=1, Criteria1:=">="
& UserForm1.TxtBox1, _
Operator:=xlAnd, Criteria2:="<=" & UserForm1.TxtBox2

Sheets("summary").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
_
Sheets("results").Range("A1")
Sheets("summary").Range("A1").AutoFilter


Charles
 
charles-
thanks so much.
Is there another way to accomplish this without using the Filter option.
The filter option works OK but I have a lot of criteria on the form (check
boxes) that will also affect the data range. I did not mention because I
thought I could get started with some basic code and then add to it.

thanks!
 
The advantage of AutoFilter is speed. You can loop through all the used
cells fairly easily too.
Dim lRow as Long 'Last Row
Dim cnt as Long
lRow = Sheets("Summary").Range("A" &
Sheets("Summary").Rows.Count).End(xlUp)
For cnt = 1 to lRow
If Range("A" & cnt) = 'YourCriteria' Then
'Your Code
End If
Next

Is that what you were after?

Charles
 
yes,but........
I am not a vb expert and I am having difficulties with the code.

I will try to explain: I have a form that you enter txtbegindate and
txtenddate. I also have "checkboxes" to even further limit the data
requested. The checkboxes are, for example:

apple total
orange total
fruit total

So if I selected a date range between 01/01/2006 and 02/01/2006 and checked
ONLY orange total and fruit total I would like the results sheet to look
something like
date orange total fruit total
01/01/2006 300 800
01/02/2006 100 500
......
02/02/2006 400 600

thanks again for you help. I have been looking around for examples and I am
coming up empty?
 
Dim lRow as Long 'Last Row
Dim nRow as Long 'Next Row to copy to
Dim cnt as Long
lRow = Sheets("Summary").Range("A" &
Sheets("Summary").Rows.Count).End(xlUp)
With Sheets("Summary")
For cnt = 1 to lRow
If .Range("A" & cnt) = 'YourCriteria' Then
nRow = Sheets("results").Range("A" & _
Sheets("results").Rows.Count).End(xlUp).Offset(1,0).Row
.Range("A" & cnt).Copy Sheets("results").Range("A" & nRow)
If CheckBox1.Value Then
.Range("B" & cnt).Copy Sheets("results").Range("B" & nRow)
End If
End If
Next
End With

Add code for more Checkboxes as needed, changing the Column Letter as
you go.

Charles
 
I am trying but
I get an error on
Irow = sheets("summary").range("a" & _
Sheets("summary").rows.count).end(xlup)

]?
 
it's error 13 type mismatch

Mona said:
I am trying but
I get an error on
Irow = sheets("summary").range("a" & _
Sheets("summary").rows.count).end(xlup)

]?

Die_Another_Day said:
Dim lRow as Long 'Last Row
Dim nRow as Long 'Next Row to copy to
Dim cnt as Long
lRow = Sheets("Summary").Range("A" &
Sheets("Summary").Rows.Count).End(xlUp)
With Sheets("Summary")
For cnt = 1 to lRow
If .Range("A" & cnt) = 'YourCriteria' Then
nRow = Sheets("results").Range("A" & _
Sheets("results").Rows.Count).End(xlUp).Offset(1,0).Row
.Range("A" & cnt).Copy Sheets("results").Range("A" & nRow)
If CheckBox1.Value Then
.Range("B" & cnt).Copy Sheets("results").Range("B" & nRow)
End If
End If
Next
End With

Add code for more Checkboxes as needed, changing the Column Letter as
you go.

Charles
 
charles- here is a copy of my code:
As you probably can tell , I am a bit confused!

lRow has a value of 39082 which is 12/31/2006. Should lRow be the # of
rows not the value of the last cell?

Also, I am having problems with:
If .Range("A" & cnt) = "txtbegindate" Then

It needs to find ">= txtbegindate and <= txtenddate" but I don't know how
to code it correctly.

Thanks so much!

Private Sub cmdOK_Click()

Dim lRow As Long 'last row
Dim nRow As Long 'Next row to copy
Dim cnt As Long


lRow = Sheets("Summary").Range("A" & _
Sheets("Summary").Rows.count).End(xlUp)

With Sheets("summary")
For count = 1 To lRow
If .Range("A" & cnt) = "txtbegindate" Then
nRow = Sheets("Results").Range("A" & _
Sheets("Results").Rows.count).End(xlUp).Offset(1, 0).Row
.Range("A" & cnt).Copy Sheets("Results").Range("A" & nRow)
If chktotalLoss.Value Then
.Range("J" & count).Copy Sheets("results").Range("J" & nRow)
End If
End If
Next
End With
 
Private Sub cmdOK_Click()


Dim lRow As Long 'last row
Dim nRow As Long 'Next row to copy
Dim cnt As Long


lRow = Sheets("Summary").Range("A" & _
Sheets("Summary").Rows.count).End(xlUp).Row


With Sheets("summary")
For count = 1 To lRow
If .Range("A" & cnt) >= txtbegindate And _
.Range("A" & cnt) <= txtenddate Then
nRow = Sheets("Results").Range("A" & _
Sheets("Results").Rows.count).End(xlUp).Offset(1, 0).Row
.Range("A" & cnt).Copy Sheets("Results").Range("A" & nRow)
If chktotalLoss.Value Then
.Range("J" & count).Copy Sheets("results").Range("J" &
nRow)
End If
End If
Next
End With

End Sub

You were right about the lRow. I forgot the .row on the end of the
statement.

Let me know if you need anything else.

Charles Chickering
 
Charles-
You have been a huge help! I really appreciate it. I am so close to
getting what I need except.......

The code I have looks like it is doing what I need but the values for
"txtbegindate" and "txtenddate" are not being passed. I even tried to use
frmDataPull.txtbegindate and frmDataPull.txtenddate. Do I need to declare
these variables somehow so that all of my subs recognize?

thanks!
 
Sorry , I should have added this:
Private Sub UserForm_Initialize()
txtbegindate.Value = ""
txtenddate.Value = ""

chkOrangeLoss = False
chkAppleLoss = False
chkTotalLoss = False
End Sub
 
Is txtbegindate and txtenddate the caption or name your textbox? If all
else fails just email me the workbook @ my posting address.

Charles
 
They are the names of my textboxes.

Die_Another_Day said:
Is txtbegindate and txtenddate the caption or name your textbox? If all
else fails just email me the workbook @ my posting address.

Charles
 
Mona, Place a breakpoint on the line where you are retrieving the value
from your textboxes, then run the code. when it stops, type this in the
immediate window:
?txtbegindate
And press enter
if it gives you the value then it is retrieving the info correctly, if
so try using the DateValue function to make sure excel knows you are
specifing a date.
if CellinQuestion >= DateValue(txtbegindate) and BlahBlahBlah

Charles
 
I was wondering if you could help me as well...
I have taken your code and put it into my worksheet. It runs, but I get no
results.
My criteria are two date ranges which I have given the name
"Filtercriteria". I only included the serial dates, not the headings. The
filtered data starts on row 7 (which is why I changed the start row to 7) and
I want the paste to start on row 2 as I have headings on the sheet1 page. Can
you assist me?

Sub CopyData()

Dim lRow As Long 'Last Row
Dim nRow As Long 'Next Row to copy to
Dim cnt As Long

lRow = Sheets("All_Jobs").Range("A" & Sheets("All_Jobs").Rows.Count).End(xlUp)
With Sheets("All_Jobs")
For cnt = 7 To lRow '<<<Filtered data starts here
If .Range("A" & cnt) = ("FilterCriteria") Then '<<<No working
nRow = Sheets("sheet1").Range("A" & _
Sheets("sheet1").Rows.Count).End(xlUp).Offset(1, 0).Row
.Range("A" & cnt).Copy Sheets("sheet1").Range("A" & nRow + 1)
"<<Will this start on row 2? Need to skip row 1 as it has headings.
End If
Next
End With

End Sub

Thank you very much!
 
The problem is in this line:
If .Range("A" & cnt) = ("FilterCriteria") Then '<<<No working
Try this instead:
If .Range("A" & cnt) >= Range("FilterCriteria").Cells(1) And .Range("A"
& cnt) <= Range("FilterCriteria").Cells(2) Then

and yes it will copy to the next empty row in Sheet1, Column A

Charles
 
EXCELLENT! That got the FIRST column of data...now I just need columns B - I
to get copied and pasted with it :)
What do I need to do to finish it?

Thanks so much!! I'm excited now!
 
I'm sure it's this line:
..Range("A:I" & cnt).Copy Sheets("sheet1").Range("A" & nRow)
I've also tried"
..Range("A" & cnt:"I" & cnt).Copy Sheets("sheet1").Range("A" & nRow)
I've also tried:
Can't seem to find the right way...
 
Gonna keep me waiting huh? LOL!!
Any ideas?

Die_Another_Day said:
The problem is in this line:
If .Range("A" & cnt) = ("FilterCriteria") Then '<<<No working
Try this instead:
If .Range("A" & cnt) >= Range("FilterCriteria").Cells(1) And .Range("A"
& cnt) <= Range("FilterCriteria").Cells(2) Then

and yes it will copy to the next empty row in Sheet1, Column A

Charles
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top