Get Information into a form?

[eluna]

I wonder if this is possible: Get the name of the company, select the dates with numbers higher than 2000 and put this info into a button or form that can be easily move to the right dates? Hope it makes sense.

Compression Calendar.XLS
	A	B	C	D	E	F	G	H	I	J	K	L
1	October2006
2		Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed
3		1	2	3	4	5	6	7	8	9	10	11
4	AmericanSocietyofPlasticSurgeons-Annual[MosconeApprovedDefinite-MosconeN]	0	0	0	700	1,000	2,000	3,000	3,000	2,900	2,600	2,000
5	AudioEngineeringSociety,Inc.-Annual[MosconeApprovedDefinite-MosconeS]	35	105	430	1,075	2,685	3,300	3,300	2,865	1,290	250	75
6	DirectMarketingAssociation-AnnualConference&Exhibition[MosconeApprovedDefinite-MosconeN&S]	0	0	0	0	0	0	0	0	50	50	125
7	Total	35	105	430	1,775	3,685	5,300	6,300	5,865	4,240	2,900	2,200
8
9		Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon	Tue	Wed
10		1	2	3	4	5	6	7	8	9	10	11
11							2,000	3,000	3,000	2,900	2,600	2,000
12					1,075	2,685	3,300	3,300	2,865	1,290
Oct06 (2)

 

[stanleydgromjr]

eluna,

I do not know what this means: "put this info into a button or form that can be easily move to the right dates"

I can get the information for you.

In your spreadsheet, copy cells 'A1:L3' into 'A17'.

Copy the below code:

'-----------Code Begins Here---------------
Sub SelectDatesWithNumbersGreaterThan2000()
'
' SelectDatesWithNumbersGreaterThan2000 Macro
' Macro created 9/15/2006 by Stanley D. Grom, Jr.
'
'
Dim intWriteRowNumber As Integer
intWriteRowNumber = 20

For Each c In [B4:L4]
If c.Value > 2000 Then
Range("A" & intWriteRowNumber & ":A" & intWriteRowNumber & "").Value = Range("A" & c.Row).Value
Worksheets("Oct06 (2)").Cells(intWriteRowNumber, c.Column) = Worksheets("Oct06 (2)").Cells(c.Row, c.Column)
End If
Next

If Range("A" & intWriteRowNumber & ":A" & intWriteRowNumber & "").Value <> "" Then
intWriteRowNumber = intWriteRowNumber + 1
End If

For Each c In [B5:L5]
If c.Value > 2000 Then
Range("A" & intWriteRowNumber & ":A" & intWriteRowNumber & "").Value = Range("A" & c.Row).Value
Worksheets("Oct06 (2)").Cells(intWriteRowNumber, c.Column) = Worksheets("Oct06 (2)").Cells(c.Row, c.Column)
End If
Next

If Range("A" & intWriteRowNumber & ":A" & intWriteRowNumber & "").Value <> "" Then
intWriteRowNumber = intWriteRowNumber + 1
End If

For Each c In [B6:L6]
If c.Value > 2000 Then
Range("A" & intWriteRowNumber & ":A" & intWriteRowNumber & "").Value = Range("A" & c.Row).Value
Worksheets("Oct06 (2)").Cells(intWriteRowNumber, c.Column) = Worksheets("Oct06 (2)").Cells(c.Row, c.Column)
End If
Next

'
End Sub
'-----------Code Ends Here-----------------


And, paste it into the Microsoft Excel Objets, Sheet1(Oct06 (2)).

Then run the macro 'SelectDatesWithNumbersGreaterThan2000'.


Have a great day,
Stan