Incredibly Urgent Help - VBA Excel

[scb998]

Hi there, i am in need of some incredibly urgent help.

I have a code that pulls out specific cells from a closed .csv file, and puts it in a "master sheet". The CSV file contains information Exported from Outlook Tasks. here is the code that takes the information from the.CSV file:
[vba]Function doFileQuery(filename As String, outSheet As String)
Dim R, c As Integer
Dim rootDir As String

rootDir = "G:\Infrastructure Services\Engineering Services\Task Lists" 'this is the folder where the task list files are saved

Dim connectionName As String
connectionName = "TEXT;" + rootDir + "\" + filename 'Goes into the specified drive and specified directory
On Error Resume Next
With Worksheets(outSheet).QueryTables.Add(Connection:=connectionName, Destination:=Worksheets(outSheet).Range("A1")) 'creates conntection to a "database" (allows the program to run without the target spreadsheet being open
.Name = filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells 'overwrites any previous information (ie old tasks)
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True 'makes column wide enough to fit information
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False 'loops arround the prompt to import data (makes the assumption that seeing as the user is running the import function, the user wants the information imported)
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited 'uses the commas in the .CSV file to make a new collumn
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:=False
If Err = 1004 Then
MsgBox (outSheet & "'s task list has not been imported")
Else
End If
End With


End Function[/vba]

when it imports the "notes" section, there is a huge problem in the import - it still works, but it puts the information in several different cells.

My planned solution is to cycle through the text in the particular cell, until it finds a special character (as i only need the first line of text) and import everything infront of the special character. how would i go about doing this?????

[Bob Phillips]

What is the special character you look for?

Have you got an example csv file we can work with?

[scb998]

the special character im searching for is "#".

here is an example of the cell i am searching:

13/08 -Draft Sent to bryce#

i want it to find the "#", then copy eerything before it into the Task list sptread sheet. (which i have attahced.)


i have attached the spreadhseet and a CSV file .

you may have to change the directory code to wherever youve saved the csv file

[scb998]

here is the master spreadhseet

[snb]

You can read an import the file using

[VBA]
Sub snb()
sheets("Scott").cells(rows.count,1).end(xlup).offset(1).resize(,8)=split(jo in(filter(split(createobject("scripting.filesystemobject").opentextfile("G: \Scott.csv").readall,vbCrLf),"#"),""),",")
end Sub
[/VBA]

[scb998]

so where abouts in the original code do i insert this?

You can read an import the file using

[vba]
Sub snb()
sheets("Scott").cells(rows.count,1).end(xlup).offset(1).resize(,8)=split(jo in(filter(split(createobject("scripting.filesystemobject").opentextfile("G: \Scott.csv").readall,vbCrLf),"#"),""),",")
end Sub
[/vba]

so where abouts in

[snb]

It's the replacement for you 'original' code.

[Aussiebear]

It's the replacement for you 'original' code.

The OP is asking for assistance. Kindly offer support or find another forum.

[scb998]

Now none of my tasks are being loaded :/

here is the full VBA code for my entire program.
[VBA]Sub import()
' filename = CSV filename without directory (scott.csv)
' outSheet = name of the worksheet in the current workbook
' where the data should go, will start in A1
Call doFileQuery("scott.CSV", "Scott")
Call doFileQuery("rael.CSV", "Rael")
Call doFileQuery("bryce.CSV", "Bryce")
Call doFileQuery("kieren.CSV", "Kieren")
Call doFileQuery("ron.CSV", "Ron")
Call doFileQuery("joel.CSV", "Joel")
Call doFileQuery("nathan.CSV", "Nathan")
Call doFileQuery("phil.CSV", "Phil")
Call doFileQuery("renae.CSV", "Renae")
Call doFileQuery("martin.CSV", "Martin")
Call doFileQuery("peter.CSV", "Peter")
Call doFileQuery("barry.CSV", "Barry")
Call doFileQuery("george.CSV", "George")
Call doFileQuery("luke.CSV", "Luke")
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim c As Integer, R As Integer
Dim D As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Master_Sheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master_Sheet"
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
' Find the last row with data on the summary worksheet.
Last = LastRow(DestSh)
' Specify the range to place the data.
'Set CopyRng = sh.UsedRange
Set CopyRng = sh.Range("A1:F22")
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats from each
' worksheet.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
' Optional: This statement will copy the sheet
' name in the H column.
DestSh.Cells(Last + 1, "G").Resize(CopyRng.Rows.Count).Value = sh.Name
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit

c = 1
R = 1
Do
If Cells(R, c).Value = "Subject" Then
Cells(R, c).Value = ""
Cells(R, 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
.Font.Size = "20"

End With
Selection.Merge
Selection.Value = Cells(R, 7).Value
End If
R = R + 1
Loop Until R = 601
Columns("G:G").Select
Range("G43").Activate
Selection.EntireColumn.Hidden = True






With ActiveSheet.Range("A1:A601")
Do
Set D = .Find("", LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False)
If D Is Nothing Then Exit Do
D.EntireRow.Hidden = True
Loop
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With


End Sub



Function doFileQuery(filename As String, outSheet As String)
Dim R, c As Integer
Dim rootDir As String

rootDir = "G:\Infrastructure Services\Engineering Services\Task Lists" 'this is the folder where the task list files are saved

Dim connectionName As String
connectionName = "TEXT;" + rootDir + "\" + filename 'Goes into the specified drive and specified directory
On Error Resume Next
With Worksheets(outSheet).QueryTables.Add(Connection:=connectionName, Destination:=Worksheets(outSheet).Range("A1")) 'creates conntection to a "database" (allows the program to run without the target spreadsheet being open
.Name = filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells 'overwrites any previous information (ie old tasks)
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True 'makes column wide enough to fit information
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False 'loops arround the prompt to import data (makes the assumption that seeing as the user is running the import function, the user wants the information imported)
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited 'uses the commas in the .CSV file to make a new collumn
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:=False
If Err = 1004 Then
MsgBox (outSheet & "'s task list has not been imported")
Else
End If
End With


End Function
[/VBA]

I need to know how to amend this code so that when it is bringing the "notes" collumn over, it only brings across everything before the special "#" character.

[mancubus]

You can read an import the file using

[vba]
Sub snb()
sheets("Scott").cells(rows.count,1).end(xlup).offset(1).resize(,8)=split(jo in(filter(split(createobject("scripting.filesystemobject").opentextfile("G: \Scott.csv").readall,vbCrLf),"#"),""),",")
end Sub
[/vba]

thanks snb.

that code is a mind opening one for me.

splitting your code into multiple lines with "_ " as below helped me undertand the code better.

i added i few lines in oder to make it work for all csv files in the same folder. (this can be re-written for importing all csv filen into one single sheet. so running the code to merge sheets into master will be avoided.)

[vba]
Sub snb()
Dim ws As Worksheet
On Error Resume Next
For Each ws In Worksheets
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = _
Split( _
Join( _
Filter( _
Split( _
CreateObject("scripting.filesystemobject"). _
opentextfile(ThisWorkbook.Path & "\" & ws.Name & ".csv"). _
readall, _
vbCrLf), _
"#"), _
""), _
",")
Next
End Sub
[/vba]

if i'm not wrong, join function with no delimeter ("") joins all lines of csw file that contains "#" in one line. outer split function splits this one line text at each ",". resizing the range to 8 columns returns first 8 elements of the final array.

my questions:

numeric values are returned with sorrounding double quotes. is there a practical way to remove quotes while importing data.

sample csv file has 12 lines that contain "#". what would your solution be it the user would like to import all 12 lines?
(i'm expecting a solution, if possible, other than running final split for each element of the array after filter.)

[snb]

It can be reduced to:

[vba]
Sub snb()
sheets("Scott").cells(rows.count,1).end(xlup).offset(1).resize(,8)=split(sp lit(createobject("scripting.filesystemobject").opentextfile("G:\Scott.csv") .readall,"#")(0),",")
End Sub
[/vba]

1. read the content of the file
2. split the text by delimiter '#'
3. take the first item after splitting : (0)
4. split that first item by delimiter comma ',' int an array
5. put that array in the first empty row.

if hypenation is a problem us can use "","" as splitting delimiter, or replace th hyphens before splitting by comma.

[vba]
replace(c01,chr(34),"")
[/vba]

[mancubus]

thanks.

because of the vbCrLf character at the end of each line, this code returned the very first line of the text joined with the second line.

expected result: (csv file has 12 lines that contain # character)
R2C1, R2C2, R2C3, R2C4, R2C5, R2C6, R2C7, R2C8
R3C1, R3C2, R3C3, R3C4, R3C5, R3C6, R3C7, R3C8
...
...
R12C1, R12C2, R12C3, R12C4, R12C5, R12C6, R12C7, R12C8

returned result:
R1C1, R1C2, R1C3, R1C4, R1C5, R1C6, R1C7R2C1, R2C2


transferring the filter-array elements to worksheet and splitting with "," seems a good solution for now.

anyway. it's a good starter for me. thanks.


and thanks to scb998 for asking the question.

[snb]

You can replace the vbcrlf 'element' in the first ietem after the splitting by a comma:

[VBA]
replace(....(0),vbcrlf,",")
[/VBA]