hi all, i have a problem with concatemate function.. i found some but need help, argumets range in function concrange must be in [a1:c1] format .. but i need to run function in cycle fe. for range [a1:c1] offset (Row, 0) ... here´s code
Function ConcRange(Substrings As Range, Optional Delim As String = "", _
Optional AsDisplayed As Boolean = False, Optional SkipBlanks As Boolean = False)
Dim CLL As Range
For Each CLL In Substrings.Cells
If Not (SkipBlanks And Trim(CLL) = "") Then
ConcRange = ConcRange & Delim & IIf(AsDisplayed, Trim(CLL.Text), Trim(CLL.Value))
End If
Next CLL
ConcRange = Mid$(ConcRange, Len(Delim) + 1)
End Function
Sub OpenMultipleFiles()
Dim Filter As String, Title As String, fName As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim sFileName As String
Dim pocetsloupcu, jmeno, nejmeno, bunka, aktivni, RowBE, RowCH, s
Dim SomeVariable
Dim myrange
pocetsloupcu = 0
RowBE = 0
RowCH = 0
Set Inpt_DATA = Workbooks(ThisWorkbook.Name).Worksheets("Sheet1")
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir ("C:\Documents and Settings\xxxxxx")
With Application
' Set File Name to selected File
Filename = .GetOpenFilename(Filter, FilterIndex, Title, True)
sFileName = Application.GetOpenFilename
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File
Workbooks.Open Filename
Sheets("Data").Select
Range("B2").Select
Do While Not IsEmpty(ActiveCell) 'count number of the row, which will be use for copy
pocetsloupcu = pocetsloupcu + 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
Application.DisplayAlerts = False
'For Row = 0 To pocetsloupcu
'Range("B2:AA2").Offset(Row, 0).Copy 'Workbooks("Book1.xls").Sheets("Sheet1").Range("A2").Offset(RowBE, 0)
'RowBE = RowBE + 1
' Range("AB2").Offset(Row, 0).Copy
' RowCH = RowCH + 1
'Next Row
For Row = 0 To pocetsloupcu
Range("AF1").Offset(Row, 0).Value = SomeVariable
SomeVariable = ConcRange(ActiveSheet.[AC2:AE2], ", ")
Next Row
Could some help me how to make it work in cycle for cells [AC2:AE2] . offset(Row, 0)??? Thanks a lot[/B
End Sub
Function ConcRange(Substrings As Range, Optional Delim As String = "", _
Optional AsDisplayed As Boolean = False, Optional SkipBlanks As Boolean = False)
Dim CLL As Range
For Each CLL In Substrings.Cells
If Not (SkipBlanks And Trim(CLL) = "") Then
ConcRange = ConcRange & Delim & IIf(AsDisplayed, Trim(CLL.Text), Trim(CLL.Value))
End If
Next CLL
ConcRange = Mid$(ConcRange, Len(Delim) + 1)
End Function
Sub OpenMultipleFiles()
Dim Filter As String, Title As String, fName As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim sFileName As String
Dim pocetsloupcu, jmeno, nejmeno, bunka, aktivni, RowBE, RowCH, s
Dim SomeVariable
Dim myrange
pocetsloupcu = 0
RowBE = 0
RowCH = 0
Set Inpt_DATA = Workbooks(ThisWorkbook.Name).Worksheets("Sheet1")
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir ("C:\Documents and Settings\xxxxxx")
With Application
' Set File Name to selected File
Filename = .GetOpenFilename(Filter, FilterIndex, Title, True)
sFileName = Application.GetOpenFilename
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File
Workbooks.Open Filename
Sheets("Data").Select
Range("B2").Select
Do While Not IsEmpty(ActiveCell) 'count number of the row, which will be use for copy
pocetsloupcu = pocetsloupcu + 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
Application.DisplayAlerts = False
'For Row = 0 To pocetsloupcu
'Range("B2:AA2").Offset(Row, 0).Copy 'Workbooks("Book1.xls").Sheets("Sheet1").Range("A2").Offset(RowBE, 0)
'RowBE = RowBE + 1
' Range("AB2").Offset(Row, 0).Copy
' RowCH = RowCH + 1
'Next Row
For Row = 0 To pocetsloupcu
Range("AF1").Offset(Row, 0).Value = SomeVariable
SomeVariable = ConcRange(ActiveSheet.[AC2:AE2], ", ")
Next Row
Could some help me how to make it work in cycle for cells [AC2:AE2] . offset(Row, 0)??? Thanks a lot[/B
End Sub
helped me a lot in my beginnings
