G
Guest
I've used simple macros in cells many times, but I'm confused as to what I
need to do when a more complex macro is required.
I got directed to a website of Excel tips (www.rondebruin.nl/summary2.htm)
and found what I think will be a workable solution to an application I'm
working on. The directions tell me to use the macro below, but I don't know
what to do with it. Where do I enter this information????? And how to I run
the macro?
My experience with macros is what I can do with "record a macro". So when I
think a macro can do something for me, I figure out the key strokes and
record them, name it, and then I can run it. But this goes way beyond that
and I'm not sure what to do with this. I don't know what I'm supposed to
type in and what information I need to add myself (parentheses means I should
type in the appropriate requested info, I think.)
Can someone direct me to a site that has information on how to use macros
like this one below?
The details of this macro are not the issue, so don't bother reading through
the entire macro unless you want to. I just need to know what to do with
this kind of information to make it work.
Example 1
Sub Summary_cells_from_Different_Workbooks_1()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change
'Select the files with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files,
*.xls", _
MultiSelect:=True)
If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)
'The links to the first workbook will start in row 2
RwNum = 1
For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1
FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)
'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName
'build the formula string
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName
& "'!"
On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(,
, xlR1C1))
If Err.Number <> 0 Then
'If the sheet name not exist in the workbook the row color
will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count +
1).Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr &
myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum
' Use AutoFit for setting the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit
MsgBox "The Summary is ready, save the file if you want to keep it"
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub
need to do when a more complex macro is required.
I got directed to a website of Excel tips (www.rondebruin.nl/summary2.htm)
and found what I think will be a workable solution to an application I'm
working on. The directions tell me to use the macro below, but I don't know
what to do with it. Where do I enter this information????? And how to I run
the macro?
My experience with macros is what I can do with "record a macro". So when I
think a macro can do something for me, I figure out the key strokes and
record them, name it, and then I can run it. But this goes way beyond that
and I'm not sure what to do with this. I don't know what I'm supposed to
type in and what information I need to add myself (parentheses means I should
type in the appropriate requested info, I think.)
Can someone direct me to a site that has information on how to use macros
like this one below?
The details of this macro are not the issue, so don't bother reading through
the entire macro unless you want to. I just need to know what to do with
this kind of information to make it work.
Example 1
Sub Summary_cells_from_Different_Workbooks_1()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change
'Select the files with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files,
*.xls", _
MultiSelect:=True)
If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)
'The links to the first workbook will start in row 2
RwNum = 1
For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1
FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)
'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName
'build the formula string
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName
& "'!"
On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(,
, xlR1C1))
If Err.Number <> 0 Then
'If the sheet name not exist in the workbook the row color
will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count +
1).Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr &
myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum
' Use AutoFit for setting the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit
MsgBox "The Summary is ready, save the file if you want to keep it"
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub