your opinions and help on my best sub thus far

[ksnapp]

Hello,

I need to add a function to the sub and don't know how to start.

It asks you to input the name of a workbook, then it asks if that
really the one you want. I need somethin after that that checks to se
if that requested workbook is open and if it is NOT stops the code an
tell the user to open the specified workbook.

also, this code works well, but I think it might be bette
accomplished than the way I did it. If any body has some ideas on ho
i could improve it I would appreciated it.

Sub data_geter()

Dim dates As New Collection
Dim yesno As New Collection
Dim days As New Collection
Dim data As New Collection
Dim collen As New Collection
Dim rnghold As Range
Dim rng As Range
Dim A As Range
Dim findme As Variant
Dim book As String
Dim TR As Single
Dim SR As Single
Dim daysCNT As Single
Dim DN As Single
Dim FN As Single
Dim SN As Single
Dim i As Single
Dim LN As Single
Dim correct As Single
Dim y As Byte

Workbooks("Book1.xls").Activate

book = Application.InputBox(PRompt:="Paste the name of source data"
Title:="What book are we using this time?", Type:=2)

correct = MsgBox(PRompt:=book, Buttons:=4, Title:="Is This Nam
Correct")

If correct = 7 Then
Exit Sub
End If

Set A = Application.InputBox(PRompt:="Select the Dates to copy for"
Type:=8)

A.Select

With Selection
daysCNT = A.Columns.Count
Set rnghold = Selection
For Each cell In rnghold
dates.Add (cell)
FN = Application.WorksheetFunction.Find("/", cell, 1)
SN = Application.WorksheetFunction.Find("/", cell, FN + 1)
DN = Mid(cell, FN + 1, SN - FN - 1)
days.Add (DN)
Next
End With

With days

For i = 1 To daysCNT Step 1
y = 0
Workbooks(book).Activate
Worksheets(days(i)).Select
TR = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a1", Cells(TR / 2, 1))
With rng
findme = "7:30"
rng.Find(what:=findme, LookIn:=xlValues).Select
On Error Resume Next
findme = "7:00"
.Find(what:=findme, LookIn:=xlValues).Select
SR = Selection.Row
If Format(Selection.Value, "H:MM") = "7:30" Then
y = 1
Else
y = 0
End If
On Error GoTo 0
data.Add (Range(Cells(SR, 6), Cells(TR, 6)))
LN = TR - SR
collen.Add (LN)
yesno.Add (y)
End With

Next i
End With

Workbooks("Book1.xls").Activate
With rnghold
For Each cell In rnghold
For i = 1 To daysCNT Step 1
If cell.Value = dates(i) Then
Range(cell.Offset(4 + yesno(i), 0), cell.Offset(collen(i) + 4
0)).Value = data(i)
End If
Next
Next


End With
End Sub




Thank Yo

 

[Frank Kabel]

Hi
just as a general comment:
- I think you're using to many select/activate statements
- in most cases it's not required to select the sheet/cells prior to do
something with them. Use an object reference and process with this
reference.

 

[Bob Phillips]

Hello,

I need to add a function to the sub and don't know how to start.

It asks you to input the name of a workbook, then it asks if thats
really the one you want. I need somethin after that that checks to see
if that requested workbook is open and if it is NOT stops the code and
tell the user to open the specified workbook.

also, this code works well, but I think it might be better
accomplished than the way I did it. If any body has some ideas on how
i could improve it I would appreciated it.

Sub data_geter()

correct = MsgBox(PRompt:=book, Buttons:=4, Title:="Is This Name
Correct")

And what does Buttons:= 4 mean? Yes I know it is Yes & No buttons, but it is
not clear. Use the builtin constants

correct = MsgBox(PRompt:=book, Buttons:=vbYesNO, Title:="Is This Name
Correct")

If correct = 7 Then
Exit Sub
End If

Diito

If correct=vbNo Then Exit Sub

Set A = Application.InputBox(PRompt:="Select the Dates to copy for",
Type:=8)

A.Select

With Selection

Why bother, why not just use With A?

daysCNT = A.Columns.Count

youqualify with the With statemanet and then explicitly use A.Columns.Count.
All you need is

daysCNT = .Columns.Count

Set rnghold = Selection
For Each cell In rnghold

Again can be simplified with

For Each cell in A

removing the need for another select

dates.Add (cell)
FN = Application.WorksheetFunction.Find("/", cell, 1)
SN = Application.WorksheetFunction.Find("/", cell, FN + 1)
DN = Mid(cell, FN + 1, SN - FN - 1)
days.Add (DN)
Next
End With

With days

For i = 1 To daysCNT Step 1
y = 0
Workbooks(book).Activate

This is not good. YOu are activating the workbook every time through the
loop. As it does not change, just activate once before the loop starts.

Worksheets(days(i)).Select
TR = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a1", Cells(TR / 2, 1))
With rng
findme = "7:30"
rng.Find(what:=findme, LookIn:=xlValues).Select
On Error Resume Next
findme = "7:00"
Find(what:=findme, LookIn:=xlValues).Select
SR = Selection.Row

don't need both those lines, just

SR = Find(what:=findme, LookIn:=xlValues)

If Format(Selection.Value, "H:MM") = "7:30" Then
y = 1
Else
y = 0
End If
On Error GoTo 0
data.Add (Range(Cells(SR, 6), Cells(TR, 6)))
LN = TR - SR
collen.Add (LN)
yesno.Add (y)
End With

Next i
End With

Workbooks("Book1.xls").Activate
With rnghold
For Each cell In rnghold
For i = 1 To daysCNT Step 1
If cell.Value = dates(i) Then
Range(cell.Offset(4 + yesno(i), 0), cell.Offset(collen(i) + 4,
0)).Value = data(i)
End If
Next
Next


End With
End Sub

Overall, complex code, not easy to follow, and not helped by an absolute
dearth of comments. What are all the variables being used for, what do the
complex loops do, and why?

Here is some code that can be used to check for a workbook being open

Function IsWbOpen(FileName As String) As Boolean
On Error Resume Next
IsWbOpen = CBool(Len(Workbooks(FileName).Name))
End Function

 

[ksnapp]

I will look into getting rid of the selections. but would you also tel
me if you know how I can make excell do the error message that tell
the used to open the names work boo

 

[Frank Kabel]

Hi
you're talking about your book1.xls file?. Why not use something like
the following (check if it's open and if not open it)

sub foo()
Dim wbk As Workbook
Dim path As String
Dim file_name As String

'Initialization
path = "C:\Temp\"
file_name = "Book1.xls"

'check if workbook is open / if not open it
On Error Resume Next
Set wbk = Workbooks(file_name)
On Error GoTo 0
If lwbk Is Nothing Then
Workbooks.Open filename:=path & file_name
Set wbk = Workbooks(file_name)
End If
wbk.activate 'though not required as you could use -wbk-
end sub

 

[ksnapp]

thank you for your honest feedback. When i try to get rid of th
selecting i get all kinds of syntax and runtime errors.

here is the code with comments
Sub data_geter()

Dim dates As New Collection ' this collection holds dates in the forma
of x/x/xx for inseting values in the end of the sub

Dim yesno As New Collection ' this collection adjusts where the data i
input based on the start time of the record

Dim days As New Collection 'this holds collection of just day numbe
(1-31) because the way i get the raw data needs this

Dim data As New Collection ' this is the data im trying to move

Dim collen As New Collection ' this is the length of the data that i
being moved

Dim rnghold As Range ' tells sub what to look for and where to put it

Dim rng As Range ' just an object variable

Dim A As Range ' return value of range selection input box

Dim findme As Variant ' finds the times i need to look for

Dim book As String ' holds the name of the book to look in for th
source data also return value of msgbox

Dim TR As Single ' column length counter

Dim SR As Single ' where the needed data stats in the column

Dim daysCNT As Single ' is the number of days selected in the A rng

Dim DN As Single ' the numbers day number of the dates im lookin for
these go into days collect

Dim FN As Single ' part of the function that pulls day number fro
date

Dim SN As Single ' part of the function that pulls day number fro
date

Dim i As Single ' counter in the for loops

Dim LN As Single ' column lenght = total rows - start row

Dim correct As Single ' return value of the msgbox tha asks if the boo
name is correct

Dim y As Byte ' tells me if the data to be added to the data collectio
started at 7:00 or 7:30

Workbooks("Book1.xls").Activate ' asks for book name that countain
source data

book = Application.InputBox(PRompt:="Paste the name of source data"
Title:="What book are we using this time?", Type:=2)

correct = MsgBox(PRompt:=book, Buttons:=4, Title:="Is This Nam
Correct")

If correct = 7 Then
Exit Sub
End If

Set A = Application.InputBox(PRompt:="Select the Dates to copy for"
Type:=8) ' to select the range of days to look for

A.Select

With Selection
daysCNT = A.Columns.Count
Set rnghold = Selection
For Each cell In rnghold ' this pulls day number from date
dates.Add (cell)
FN = Application.WorksheetFunction.Find("/", cell, 1)
SN = Application.WorksheetFunction.Find("/", cell, FN + 1)
DN = Mid(cell, FN + 1, SN - FN - 1)
days.Add (DN)
Next
End With

With days

For i = 1 To daysCNT Step 1
y = 0
Workbooks(book).Activate
Worksheets(days(i)).Select
TR = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a1", Cells(TR / 2, 1))
With rng
findme = "7:30" ' i need the record from 7:00 if that is present
but 7:30 is always present so this was my solution

rng.Find(what:=findme, LookIn:=xlValues).Select
On Error Resume Next
findme = "7:00"
.Find(what:=findme, LookIn:=xlValues).Select
SR = Selection.Row ' this gives the row to start collecting dat
from
If Format(Selection.Value, "H:MM") = "7:30" Then ' if the dat
started at 7:30 this lets me know so I can put it in the apropriat
place
y = 1
Else
y = 0
End If
On Error GoTo 0 ' this is cause i want error msgs to appear afte
the previous debacle
data.Add (Range(Cells(SR, 6), Cells(TR, 6)))
LN = TR - SR ' number of cell in each data collection entry
collen.Add (LN)
yesno.Add (y)
End With

Next i
End With

Workbooks("Book1.xls").Activate
With rnghold
For Each cell In rnghold
For i = 1 To daysCNT Step 1 ' it the cell in this range matches th
a date in the dates collection it inputs the collection of data wit
the same (i) value
If cell.Value = dates(i) Then
Range(cell.Offset(4 + yesno(i), 0), cell.Offset(collen(i) + 4
0)).Value = data(i) ' this tells where to put the data so i don't ge
all the cells with N/A
End If
Next
Next


End With
End Su