Click here to Skip to main content
15,894,291 members
Home / Discussions / Visual Basic
   

Visual Basic

 
QuestionExcel Question Pin
ghettoneck12-Feb-07 16:07
ghettoneck12-Feb-07 16:07 
QuestionFile Association..pls help Pin
carl_sti12-Feb-07 14:59
carl_sti12-Feb-07 14:59 
AnswerRe: File Association..pls help Pin
TwoFaced12-Feb-07 15:53
TwoFaced12-Feb-07 15:53 
GeneralRe: File Association..pls help Pin
carl_sti12-Feb-07 16:26
carl_sti12-Feb-07 16:26 
GeneralRe: File Association..pls help Pin
M-Hall12-Feb-07 17:02
M-Hall12-Feb-07 17:02 
GeneralRe: File Association..pls help Pin
carl_sti12-Feb-07 17:34
carl_sti12-Feb-07 17:34 
Questionrename the existed excel worksheet name Pin
JaneQuestion12-Feb-07 13:29
JaneQuestion12-Feb-07 13:29 
AnswerRe: rename the existed excel worksheet name Pin
ajay5888612-Feb-07 20:16
ajay5888612-Feb-07 20:16 
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 = "summary" '< Change
Set Rng = Range("D3") '< 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 1
RwNum = 0
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 = FileNameXls(FNum)

'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

SummWks.UsedRange.Value = SummWks.UsedRange.Value
SummWks.UsedRange.Columns("B:B").TextToColumns Destination:=Columns("E:E"), DataType:=xlDelimited, _



TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _



Semicolon:=False, Comma:=False, Space:=True, Other:=False, _



TrailingMinusNumbers:=True



SummWks.UsedRange.Columns("C").Formula = "=sum(E1:IV1)"



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


try it............Blush | :O


Imagine the I.T

QuestionVista always shows ipv6 address - how to only get ipv4 local address? Pin
Mr Plant12-Feb-07 10:11
Mr Plant12-Feb-07 10:11 
AnswerRe: Vista always shows ipv6 address - how to only get ipv4 local address? Pin
M-Hall12-Feb-07 17:41
M-Hall12-Feb-07 17:41 
QuestionError message: vbc30205? Pin
Shima. M.12-Feb-07 7:45
Shima. M.12-Feb-07 7:45 
AnswerRe: Error message: vbc30205? Pin
Kschuler12-Feb-07 8:43
Kschuler12-Feb-07 8:43 
QuestionTabPages Pin
CodingYoshi12-Feb-07 7:43
CodingYoshi12-Feb-07 7:43 
AnswerRe: TabPages Pin
Christian Graus12-Feb-07 10:31
protectorChristian Graus12-Feb-07 10:31 
QuestionIts is possible to make it on vb.net? Pin
blitz00212-Feb-07 6:52
blitz00212-Feb-07 6:52 
AnswerRe: Its is possible to make it on vb.net? Pin
nlarson1112-Feb-07 7:08
nlarson1112-Feb-07 7:08 
AnswerRe: Its is possible to make it on vb.net? Pin
Christian Graus12-Feb-07 10:28
protectorChristian Graus12-Feb-07 10:28 
AnswerRe: Its is possible to make it on vb.net? Pin
Squeaker12-Feb-07 14:59
Squeaker12-Feb-07 14:59 
QuestionEAN13 ? Pin
Polymorpher12-Feb-07 5:45
Polymorpher12-Feb-07 5:45 
AnswerRe: EAN13 ? Pin
andyharman12-Feb-07 6:14
professionalandyharman12-Feb-07 6:14 
GeneralRe: EAN13 ? Pin
Polymorpher12-Feb-07 6:49
Polymorpher12-Feb-07 6:49 
QuestionError Message [modified] Pin
jds120712-Feb-07 5:03
jds120712-Feb-07 5:03 
AnswerRe: Error Message Pin
Johan Hakkesteegt12-Feb-07 20:50
Johan Hakkesteegt12-Feb-07 20:50 
Questioncmd non execute error Pin
muraguri12-Feb-07 4:17
muraguri12-Feb-07 4:17 
AnswerRe: cmd non execute error Pin
Colin Angus Mackay12-Feb-07 5:14
Colin Angus Mackay12-Feb-07 5:14 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.