Some Macro Help Please

G

Guest

A couple of things I would like to add to this macro is a prompt at the
beginning that says "Please enter hours and miles first" True = continue
False = end

The second thing is on the Workbooks.Open command. Is there a way to have
all links and formulas to update and save without opening? If not I would
like a user prompt for each number or better yet can it look at a list of
tech numbers and match them to say "R2C3:R200C3" like you would write an
Index and Match formula in Excel?

ActiveSheet.Unprotect
Application.Goto Reference:="R2C9:R200C15"
Selection.ClearContents
Application.Goto Reference:="R2C24:R200C28"
Selection.ClearContents
Application.Goto Reference:="R2C35:R200C39"
Selection.ClearContents
Range("A2").Select
Workbooks.Open ("C:\IMPORT.XLS")
Application.Goto Reference:="R200C15"
ActiveCell.FormulaR1C1 = " "
Application.Goto Reference:="R200C16"
ActiveCell.FormulaR1C1 = " "
Application.Goto Reference:="R2C1:R200C1"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C1:R200C1"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C3:R200C3"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C2:R200C2"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C4:R200C4"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C3:R200C3"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C5:R200C5"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C4:R200C4"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C6:R200C6"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C5:R200C5"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C8:R200C8"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C6:R200C6"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C9:R200C9"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C7:R200C7"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C10:R200C10"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C8:R200C8"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C11:R200C11"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C9:R200C9"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.TextToColumns Destination:=Range("I2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(Array(1, 1), Array(2, 1)),
TrailingMinusNumbers:=True
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C16:R200C16"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C24:R200C24"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Selection.TextToColumns Destination:=Range("X2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Windows("IMPORT.XLS").Activate
Application.Goto Reference:="R2C15:R200C15"
Selection.Copy
Windows("1DLSUNDAY.XLS").Activate
Application.Goto Reference:="R2C35:R200C35"
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Selection.TextToColumns Destination:=Range("IA2"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
"-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("A2").Select
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\WEEKLY TOTALS NEW")
Calculate
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9501.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9502.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9503.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9504.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9505.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9506.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9507.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9508.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9509.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9510.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9511.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9512.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9513.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9514.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9515.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9516.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9517.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9518.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9519.XLS")
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\9520.XLS")
Calculate
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFiltering:=True
Workbooks.Open ("C:\Documents and Settings\Tom\Desktop\CHARTER BLANK\NEW
BLANK\WEEKLY TOTALS NEW")
End Sub
 
G

Guest

ans = Msgbox("Please enter hours and miles first", _
vbYesNo,"Hours and Miles")
if ans = vbNo then
exit sub
end if


although it seems the question should be "Are hours and miles entered?"

I don't understand your second question.
 
G

Guest

Thank you for that message box and the code for my mileage cap. If you look
toward the end of my macro I open a workbook for each Tech ie; 9501, 9502 etc.
I only need to open them to update the information if that tech worked that
day the macro you are looking at is for Sunday I have one for each day of the
week there is a column in 1DLSunday for the tech number. If the
workbooks.open could refer to this column and only open the files for techs
that worked that day it would save some time when i get up to 30 or 40 techs
with 200 to 300 jobs. I've already done an Index, Match formula to pull that
techs jobs out and put them on his own sheet which is where his workbook
pulls all of its info from each day and compiles it into a week and then that
file updates a payroll workbook.
 
G

Guest

Change workbook, sheet names and cell locations to reflect your actual setup.

With Workbooks("1DLSUNDAY.XLS").worksheets("TechList")
set rng = .Range(.Cells(1,"E"),.Cells(1,"E").end(xldown))
End with

for each cell in rng
workbooks.Open "C:\Documents and" &_
" Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\" & _
cell.Value & ".xls"
Next

--
Regards,
Tom Ogilvy

Tom Ogilvy
 
G

Guest

Just looking at it will it try to open say 9501's workbook once for every
instance of 9501 in column C because it has multiple entries of 9501 (one for
each job completed that day) also I don't really understand the .Cells
relationship , is (1,"E") refering to row 1, column 5?
 
G

Guest

cells is indexed with row, then column. so yes, cells(1,"E") is E1. You
can also use Cells(1,5)

Because there are duplicates, you can just ignore the error of attempting to
open a workbook twice:

With Workbooks("1DLSUNDAY.XLS").worksheets("TechList")
set rng = .Range(.Cells(1,"E"),.Cells(1,"E").end(xldown))
End with

On Error Resume Next
for each cell in rng
workbooks.Open "C:\Documents and" &_
" Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\" & _
cell.Value & ".xls"
Next
On Error goto 0

or we could build a collection and avoid the error:

Dim bkList as New Collection
With Workbooks("1DLSUNDAY.XLS").worksheets("TechList")
set rng = .Range(.Cells(1,"E"),.Cells(1,"E").end(xldown))
End with

On error Resume Next
for each cell in rng
bklist.Add trim(cell.Text), trim(cell.Text)
Next
On Error goto 0

for each itm in collection
workbooks.Open "C:\Documents and" &_
" Settings\Tom\Desktop\CHARTER BLANK\NEW BLANK\" & _
itm & ".xls"
Next
 

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

Similar Threads

Copy paste - Values - formula - Optimise 2
Help again!!! 1
Need a loop in my macro 2
conso macro 0
Find existing number in another workbook 11
REpeating Values 2
A better Macro for Copying Data 2
Run macro from active workbook whose name keeps changing 20

Top