VBA Copy and process data from multiple workbooks to string and then to notepad.

[devi prasad kar]

Hi guys,

Hope you can help me out, I'm a newbie here but I'm always looking for ways to reduce amount of time in getting data. I have multiple workbooks(Source) in one folder (C:\Users\dot\Desktop\test\) from which I would like to pull texts. Change the texts as per predefined conditions and save them to a string. And then the string to a notepad(destination) .

Source-1st CSV file-

1 % Gap-down.csv
	L
10
1 % Gap-down

2nd CSV file-

Big Green & Gap up High.csv
	H
12
Big Green & Gap up High

3rd csv file-

Elephant Gap-up.csv
	H
10
Elephant Gap-up

So on so forth it goes .

Result desired-
1.Code will read the source workbook name and only column B texts until next row does not contain any value .Process the same as per condition and store it to a string to export to notepad. Please note 1st row is header , so text in B1 is of no use of all source files.
2. "###"&1st workbook name & ","&"NSE"&":"&B1&","&"NSE"&":"&B2&","&"NSE"&":"&B3 ...... until empty row ,"###"&2nd workbook name & ","&"NSE"&":"&B1&","&"NSE"&":"&B2&","&"NSE"&":"&B3 ...... until empty row
,"###"&3rd workbook name & ","&"NSE"&":"&B1&","&"NSE"&":"&B2&","&"NSE"&":"&B3 ...... until empty row
until all csv files in the folder are visited/processed .

File extension .csv not desired in workbook name .

Sample result string looks like (as manually typed for easy reference as below)-
###1 % Gap-down,NSE:HEG,NSE:HEIDELBERG,NSE:VARROC,NSE:LINDEINDIA,NSE:AUBANK,NSE:M_MFIN,NSE:ULTRACEMCO,NSE:INFY,NSE:AMARAJABAT,###Big Green & Gap up High,NSE:ONGC,###Elephant Gap-up

Any help or guidance is welcome .

 

[devi prasad kar]

Finally copy pasted some code found on web

Sub csv_to_notepad()
'https://www.mrexcel.com/board/threads/vba-to-copy-data-from-multiple-workbooks-into-master-sheet-including-source-worksheet-name.1170899/
 
  Dim wkbSource       As Workbook
 
  Dim wksDest         As Worksheet
 
  Dim LastRow         As Long
  Dim lngRowData      As Long
 
  Dim strExtension    As String
 
  Const cstrPATH      As String = "C:\Users\donu\Desktop\chtvmaro\"
 'clear 1st two columns for new data sourcing
 Range(Cells(1, 3), Cells(Range("A2").End(xlDown).Row, 1)).Value = vbNullString
 'Range(Cells(1, 2), Cells(Range("B2").End(xlDown).Row, 1)).Value = vbNullString
 'Range(Cells(1,3), Cells(Range("A3").End(xlDown).Row,1)).Value = vbNullString
 
 
  Application.ScreenUpdating = False
  'setting an object to the worksheet to write to
  Set wksDest = ThisWorkbook.Sheets(1)
 
  strExtension = Dir(cstrPATH & "*.csv*")
 
  Do While strExtension <> ""
    Set wkbSource = Workbooks.Open(cstrPATH & strExtension)
    With wkbSource
      LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      MsgBox LastRow
      'additional line for getting the first row to write to
      lngRowData = wksDest.Range("B" & Rows.Count).End(xlUp).Row + 1
      MsgBox lngRowData
      'like mentioned in the text copy columns B to D
      .Sheets(1).Range("B2:B" & LastRow).Copy wksDest.Range("B" & lngRowData)
      'filling in the sheet name
      wksDest.Range("A" & lngRowData).Resize(LastRow, 1).Value = .Sheets(1).Name
      .Close savechanges:=False
    End With
    strExtension = Dir
  Loop
  
  '///---------->>>>>>>>-----------<<<<<<<
  Dim lngCount As Long
lngCount = Application.WorksheetFunction.CountA(Columns(1))
MsgBox lngRowData
  
  
  '///---------->>>>>>>>----------<<<<<<<
  
  For i = 2 To lngCount
    Range("C" & i).Value = "," & "###" & Range("A" & i).Value & "," & "NSE" & ":" & Range("B" & i).Value & ","
  Next i

  Set wkbSource = Nothing
  Set wksDest = Nothing
  Application.ScreenUpdating = True
  
  ActiveWorkbook.Save
  
  '////////////////////////////////////////
  '////////////////////////////////// to the notepad we go
  
  Dim s As String, FileName As String, FileNum As Integer
 
  ' Define full pathname to TXT file
  FileName = ThisWorkbook.Path & "\4 chartinkscreeners.txt"
 
  ' Copy range of B column to the clipboard
  Range("C1", Cells(Rows.Count, "C").End(xlUp)).Copy
 
  ' Copy clipboard text to the 's' variable
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
     .GetFromClipboard
     s = .GetText
  End With
  Application.CutCopyMode = False
 
  ' Write s to the TXT file
  FileNum = FreeFile
  If Len(Dir(FileName)) > 0 Then Kill FileName
  Open FileName For Binary Access Write As FileNum
  Put FileNum, , s
  Close FileNum
  
  'to the notepad we reached ///////////////////////
  
  
  

End Sub

But in case of any source sheet is has no data , then it is throwing below error .
Need help , in case of there any blank sheet then just skip to next file to copy and paste .

 

[devi prasad kar]

Error coming after

LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row