Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Some Macro Help Please
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 48
Default Some Macro Help Please
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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Some Macro Help Please
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.

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 48
Default Some Macro Help Please
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.

"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Some Macro Help Please
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



"Tomkat743" wrote:

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.

"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 48
Default Some Macro Help Please
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?

"Tom Ogilvy" wrote:

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



"Tomkat743" wrote:

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.

"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Some Macro Help Please
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

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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?

"Tom Ogilvy" wrote:

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



"Tomkat743" wrote:

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.

"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy

"Tomkat743" wrote:

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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro recorded... tabs & file names changed, macro hangs Steve Excel Worksheet Functions 3 October 30th 09 11:41 AM
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort Gavin Excel Worksheet Functions 0 May 17th 07 01:20 PM
how to count/sum by function/macro to get the number of record to do copy/paste in macro tango Excel Programming 1 October 15th 04 01:16 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 07:40 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement