Skip blank rows when copy range to text file - excel

My procedure copy Lg1 rows form an Excel range to a text file. I want to prevent any blank row form being copied to the text file. First cells of each row contained this formula : =IF(L39C7=0;"";L15C20). As you can see, the cell is or empty " ", or contains L15C20 value.
EDIT : here is one fulle row. All rows have same content:[=IF(L39C7=0;"";L15C20)],[=IF(LC(-1)="";"";IF(L39C7<0;"…";"5272"))],[=IF(LC(-2)="";"";IF(L41C7<0;"…";"2302"))],[=IF(LC(-3)="";"";"salaire")],[=IF(LC(-4)="";"";"0")]
Here is part of my code:
With ws
Set RngSelect = .Range(Cells(FirstRow, FirstCol), Cells(31, LastCol))
End with
With RngSelect
For Lg1 = 1 To (LastRow - FirstRow + 1)
If .Cells(Lg1,1).Value <> "" Then 'Here is my issue
Txt = Txt & vbCrLf & Join$(Application.Transpose(Application.Transpose(.Rows(Lg1).Value)), vbTab)
Next
End If
End With
Lg2 = FreeFile()
Open FilePath For Append As #Lg2
Print #Lg2, Mid$(Txt, Len(vbCrLf) + 1)
Close Lg2
I have tried with no success various tests to evaluate If cell <> " " but keep having blank rows in my text file. What shall I write to solve my issue?
Thank you for help.

It could be better to check for blank in this way (here, for the first column within your range):
If Len(.Cells(Lg1, 1).Value) > 0 Then

Related

Copy values based on match criteria

Data Sheet
I have two workbooks with the same content. I am copying and pasting the amount values from one workbook sheet to another when the project number and division is the same. The amount has to be pasted in the row where there is a match. The issue I am facing is all the amounts are getting copied but not pasted near the respective match.
The code I have used is as follows:
ws1PRNum = "E" 'Project Number
ws1Div = "I" 'Division
ws2PRNum = "E" 'Project Number
ws2Div = "I" 'Division
'Setting first and last row for the columns in both sheets
ws1PRRow = 5 'The row we want to start processing first
ws1EndRow = wsSrc.UsedRange.Rows(wsSrc.UsedRange.Rows.count).Row
ws2PRRow = 5 'The row we want to start search first
ws2EndRow = wsDest.UsedRange.Rows(wsDest.UsedRange.Rows.count).Row
For i = ws1PRRow To ws1EndRow 'first and last row
searchKey = wsSrc.Range(ws1PRNum & i) & wsSrc.Range(ws1Div & i) 'PR line and number is Master Backlog
'if we have a non blank search term then iterate through possible matches
If (searchKey <> "") Then
For j = ws2PRRow To ws2EndRow 'first and last row
foundKey = wsDest.Range(ws2PRNum & j) & wsDest.Range(ws2Div & j) 'PR line and number in PR Report
'Copy result if there is a match between PR number and line in both sheets
If (searchKey = foundKey) Then
'Copying data where the rows match
wsDest.Range("AJ5", "AU1200").Value = wsSrc.Range("AJ5", "AU1200").Value
wsDest.Range("BB5", "BM1200").Value = wsSrc.Range("BB5", "BM1200").Value
wsDest.Range("BT5", "BU1200").Value = wsSrc.Range("BT5", "BU1200").Value
Exit For
End If
Next
End If
Next
This is the area that is causing an issue. As seen in the picture the amounts are pasted even in rows where the division and project number are empty. Any answer for the same would be highly appreciated as I am not well versed with VBA.
You can do this:
wsDest.Range("AJ" & j, "AU" & j).Value = wsSrc.Range("AJ" & i, "AU" & i).Value
'etc...
or with a bit less concatenation:
wsDest.Rows(j).Range("AJ1:AU1").Value = wsSrc.Rows(i).Range("AJ1:AU1").Value

How from Columns separated dataset, to a comma separated one?

i need to separate the columns of my dataset into comma separated how con I do this? I need a dataset that looks like this:
#VBasic2008 here is what i get in the middle of the sheet: the first and second row are my tries with your function CONCAT. While i need something like the rightest part of the image.... like 6,40,45,52. Not all the values merged..
So i did it using CONCAT function but i had to manually compute that for each column i show how for the ones that eventually will need help (note i used ; instead of , beacause my excel seems not working with ,)
and this is finally the final output
Ok but what if I have a dataset of 1000 columns? This process need to be much much quicker than this. This is not optimized.
I have written several comments on your question which may be hard to follow. So I decided to make a full solution which actually a trick.
Note that Microsoft Excel tries to guess the data structure of the file content if the file is suffixed with .csv (extension). For that reason, whenever you open a .csv file, you get your data in columns instead of a single columns with comma separated values.
In order to achieve what you want, first, save your data as in the comma separated values (.csv) file format.
Then change your file extension from .csv to, i.e. .txt (text file) for example:
if your file name is "data.csv", change it to "data.txt". Please make sure you see the file extension as csv before you change it because in some case you don't see the file extension; therefore when you rename it, it remains a csv file.
Note: If you don't see file extension, if you are on Microsoft Windows, follow this link.
Once you rename the file into txt file format, you can then open it in your Excel application by going to File -> Open -> then browse the txt file.
There you go and get what you one.
You don't need to code or use any functions to achieve that although you can choose to do so if you wish as it is also a good solution.
If you are looking for a formula solution
TEXTJOIN(", ", TRUE, Range)
where Range is the column span of expected values
Option Explicit
Sub CSV()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LR As Long, xRow As Range
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each xRow In ws.Range("A1:A" & LR)
xRow.Offset(0, 6).Value = WorksheetFunction.TextJoin(", ", True, xRow.Resize(1, 6))
Next xRow
Application.ScreenUpdating = True
End Sub
This is already separated by commas, so you just have to rename it to a .csv file.
in Windows Explorer, go to the ribbon and go to the 'view' tab and enable 'File Name Extensions'.
Navigate to your file, right click and rename it to THEFILENAME.csv instead of THEFILENAME.xlsx
Now when you open this up in excel, it should have the grid.
What is the extension of the file? .xls, .txt or .csv?
If it is in .xls then you can simply open the file in Excel and then use the File->save as menu and then selecting the Comma Separated from the file type drop down.
If file has .csv extension and you are trying to open it in Excel then you will see columns even the file has commas in it. To verify that if the file is comma separated then simply open with notepad or other text editors to see the comma separated values.
If there is any other separator like colon : or other and want to replace with comma then simply use the find and replace option in notepad.
CONCAT Excel UDF
I wrote this a while ago.
In VBE add a module and copy the following code to it.
The Code
'*******************************************************************************
' Purpose: Concatenates the values of cells of a specified range.
' Read only. String.
' Syntax: CONCAT(Range, Separator, Row0Column1)
' Inputs:
' Range A valid range in any open workbook. Required.
' Separator A string to be used as a separator between the values.
' Default is the space character. Optional.
' Row0Column1 If 0 it concatenates by row, if 1 then by column.
' Default is 0. Optional.
' Returns: A string containing all the values of the specified range.
'*******************************************************************************
Function CONCAT(ByVal Range As Range, Optional Separator As String = _
" ", Optional Row0Column1 As Long = 0) As String
'***************************************
' Variables
Dim xdRowStart As Long, xdRowEnd As Long, xdRowCounter As Long
Dim xdColumnStart As Long, xdColumnEnd As Long, _
xdColumnCounter As Long
Dim xdSep As String, xdString As String, xdCheckEmptyString As String
Dim xdWS As Worksheet
'***************************************
' Values
xdString = ""
xdSep = Separator
Set xdWS = Range.Worksheet
xdRowStart = Range.Row
xdRowEnd = xdRowStart + Range.Rows.count - 1
xdColumnStart = Range.Column
xdColumnEnd = xdColumnStart + Range.Columns.count - 1
'***************************************
' Determine concatenated direction: by row or by column
Select Case Row0Column1
Case 0
GoTo ConcatenateByRow
Case 1
GoTo ConcatenateByColumn
Case Else
MsgBox "Row0Column1:" & vbCr _
& "Ommit or use 0 for Concatenating by Row." & vbCr _
& "Use 1 for Concatenating by Column."
GoTo ConcatenateFinal
End Select
'***************************************
' Concatenate by Row:
ConcatenateByRow:
For xdRowCounter = xdRowStart To xdRowEnd
For xdColumnCounter = xdColumnStart To xdColumnEnd
If xdString = "" Then 'xdString is empty; all cells were empty so far
xdCheckEmptyString = xdWS.Cells(xdRowCounter, xdColumnCounter)
If xdCheckEmptyString <> "" Then 'Cell is not empty
xdString = xdCheckEmptyString
End If
Else 'xdString is not empty
xdCheckEmptyString = xdWS.Cells(xdRowCounter, xdColumnCounter)
If xdCheckEmptyString <> "" Then 'Cell is not empty
xdString = xdString & xdSep & xdCheckEmptyString
End If
End If
Next xdColumnCounter
Next xdRowCounter
GoTo ConcatenateFinal
'***************************************
' Concatenate by Column:
ConcatenateByColumn:
For xdColumnCounter = xdColumnStart To xdColumnEnd
For xdRowCounter = xdRowStart To xdRowEnd
If xdString = "" Then 'xdString is empty; all cells were empty so far
xdCheckEmptyString = xdWS.Cells(xdRowCounter, xdColumnCounter)
If xdCheckEmptyString <> "" Then 'Cell is not empty
xdString = xdCheckEmptyString
End If
Else 'xdString is not empty
xdCheckEmptyString = xdWS.Cells(xdRowCounter, xdColumnCounter)
If xdCheckEmptyString <> "" Then 'Cell is not empty
xdString = xdString & xdSep & xdCheckEmptyString
End If
End If
Next xdRowCounter
Next xdColumnCounter
GoTo ConcatenateFinal
'***************************************
ConcatenateFinal:
CONCAT = xdString
End Function
'*******************************************************************************
Usage in Excel
=CONCAT($A1:$G1,",") and copy down:
=CONCAT($A2:$G2,",")

excel macro to import a csv file entered by user which is in shared drive and combine all the rows to one

I need an Excel macro code that opens the user specified .csv file that exists in a shared drive and combines all the text into an array variable. This code is just a part of my case function.
Eg,
My csv file looks like this(It just has one column only)
line 1:apple|orange|grapes
line 2:potato|onion
Required output
searchTerms="apple|orange|grapes|potato|onion,..."
This was my attempt in writing the code:
Case Is = 4
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
lrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = 1 To lrow
counter = counter + 1
If counter = lrow Then Exit Sub
Cells(i, 1).Value
searchTerms = Trim(Cells(i, 1).Value) & "|" & " " & Cells(i + 1, 1).Value
Cells(i + 1, 1).EntireRow.Delete
i = i - 1
Next i
Using Application.Workbooks.Open (csvFileName) opened the required file as Jane suggested but still not able to figure out why its showing error at Cells(i,1).Value. So basically not able to combine all the data (in csv) into searchTerms still.
The MSDN topic for GetOpenFilename (https://msdn.microsoft.com/en-us/library/office/aa195744(v=office.11).aspx) describes what this function does:
"Displays the standard Open dialog box and gets a file name from the user without actually opening any files."
This means that after calling GetOpenFileName, your code will need to actually open the file:
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
Application.Workbooks.Open (csvFileName)
UPDATE:
The line Cells(i, 1).Value is giving an error because there isn't a valid statement or instruction for VBA to handle. You can use this statement to retrieve the value from a cell:
x = Cells(i, 1).Value
or to set the value in a cell:
Cells(i, 1).Value =x
but you're not doing either of those things. This line isn't doing anything useful and can be removed.
There are several other problems with the code. The following line finds out how many rows are in the sheet, then checks the row number of that row (eg if there are 3 rows, it asks for the row number of row 3):
lrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
You can just use:
lrow = ActiveSheet.UsedRange.Rows.Count
When you go through the loop, you take the value from the first cell, and add the pipe and the value from the current cell:
searchTerms = Trim(Cells(i, 1).Value) & "|" & " " & Cells(i + 1, 1).Value
However, this value is then thrown away when you get to the next cell, and you combine the value from the first cell with the pipe and the latest cell. This will work if there are only 2 rows, but for any more, you'll only end up with the values from the first and last cell. You could either store the updated searchTerms value in the first cell at each step in the loop, or you can just combine the values correctly as you go along.
Deleting the rows as you go along is probably causing the code to be more convoluted than it needs to be (eg needing to change the value of i within the loop and having a separate variable which exits the loop. I'd suggest avoiding that and just loop through the cells to create the searchTerms value. If you really need to delete the values, I'd do so afterwards. Here's how I've updated the code:
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
Application.Workbooks.Open (csvFileName)
lrow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lrow
If i = 1 Then
searchTerms = Trim(Cells(i, 1).Value)
Else
searchTerms = searchTerms & "|" & Trim(Cells(i, 1).Value)
End If
Next i
Debug.Print searchTerms
One additional point is that you've added a space after the pipe symbol when joining the strings. I've left that in, but it's not in your sample text, so you may need to remove it.

loop using CStr to increment row

I am looping through a file (junk data.xlsx) to capture data for (thisworkbook). For range C1 it is a direct reference to the data in the junk data file and works just great by using CStr to increment the row number in the junk data file. But when I use a formula for the cell contents in the junk data file to strip off the left three characters (=LEFT(C1,3) for range A1 I get a syntax error message. Something wrong with what I am trying to do?
Dim r As Integer 'for row count in junk data file
r = 1
Workbooks("junk data.xlsx").Sheets("sheet1").Activate
'loop through junk data file until an empty row is found
Do While Cells(r, 1) <> ""
ThisWorkbook.Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "=LEFT('[junk data.xlsx]Sheet1'!R" & CStr(r) &"C1",3)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "='[junk data.xlsx]Sheet1'!R" & CStr(r) & "C8"
Workbooks("junk data.xlsx").Sheets("sheet1").Activate
r = r + 1
Loop
&"C1",3)"
one quotation mark too many:
&"C1,3)"
Perhaps I misunderstand what you are trying to do, but Left(s,3) doesn't "strip off the left 3 characters". It does the opposite. It retains those characters and removes everything else. You seem to want Mid():
Sub test()
Dim s As String
s = "Hello World"
MsgBox Left(s, 3) 'diplays "Hel"
MsgBox Mid(s, 4) 'displays "lo world"
End Sub

Concatenate path and filename recursively

I have an output exported to Excel which lists paths and filenames.
The paths and filenames are on separate rows however. If the path is consistent the filename is simply listed on the next row. Then the next path is on the next line followed by filenames ect.
C:\
file1.doc
C:\Windows\
file2.doc
file3.doc
file4.doc
C:\Windows\Folder\
file5.doc
I need to concatenate all the paths with the filenames. All paths begin with c:\ (or other drive letters which can be defined). For the example above the following output is required:
C:\file1.doc
C:\Windows\file2.doc
C:\Windows\file3.doc
C:\Windows\file4.doc
C:\Windows\Folder\file2.doc
Happy to have white spaces as these can be filtered out in Excel.
Thanks,
Jono
VBA approach:
Sub test()
Dim ws As Worksheet
Dim iRow As Long
Dim i As Integer
Dim strFirstValue, strScndValue, strNewValue, strValue As String
Dim startFlag, endFlag As Boolean
Set ws = Sheets(1)
iRow = ws.Range("A1048576").End(xlUp).Row
strFirstValue = ws.Range("A2:A2")
strFirstValue = "": strScndValue = ""
startFlag = False
strFirstValue = ws.Range("A2:A2")
For i = 2 To iRow 'Assuming you have header, otherwise change 2 to 1
If endFlag Then
strFirstValue = ws.Range("A" & i & ":A" & i)
End If
strValue = strFirstValue
strScndValue = ws.Range("A" & i + 1 & ":A" & i + 1)
If InStr(strValue, ":") > 0 Then
startFlag = True
If Not strScndValue = "" Then
If Not InStr(strScndValue, ":") > 0 Then
strNewValue = strFirstValue & strScndValue
ws.Range("B" & i + 1 & ":B" & i + 1) = strNewValue
endFlag = False
Else
endFlag = True
End If
End If
End If
Next i
'To remove the row with drive info
For i = 2 To iRow
strValue = ws.Range("B" & i & ":B" & i)
If strValue = "" Then
ws.Range("B" & i & ":B" & i).EntireRow.Delete
End If
Next i
Set ws = Nothing
End Sub
Before:
After:
With data in column A, this macro will put the results in column B:
Sub dural()
Dim s As String, J As Long, r As Range
J = 1
For Each r In Intersect(ActiveSheet.UsedRange, Range("A:A"))
s = r.Text
If s = "" Then Exit Sub
If Right(s, 1) = "\" Then
pref = s
Else
Cells(J, 2).Value = pref & s
J = J + 1
End If
Next r
End Sub
Non-VBA solution, which will require some helper columns:
Assuming your data is in column A, and you don't care about sorting the results / having blanks within the results:
Put this in cell B2 and copy down [I recommend you have a header row for row 1]
=if(mid(A2,2,2)=":/",A2,B1)
This puts the new file path in column B, and if it's not a new file path (doesn't start with "x:/"), it takes the file path from column the previous cell.
In cell C2, copied down:
=if(mid(A2,2,2)=":/","",B2&A2)
This checks if the line you're on is a file path or a file name. If it's a file name, it adds the file name to the file path and displays as a single string. If it's a filepath, it returns a blank.
Alternatively you could save a tiny bit of processing time by using columns B-D instead of B-C. Some calculation is wasted here because we are doing the same check ("does cell A2 include ':/'?") twice, so excel needs to calculate it twice. Like so:
Put this in Cell B2:
=mid(a2,2,2)=":/"
Returns TRUE if the cell in column A is a filepath; returns FALSE if the cell in column A is a filename. Then put this in cell C2 and copy down:
=if(B2,A2,B1)
Works same as above, but uses the test already defined in cell B2. Put this in cell D2 and copy down:
=if(B2,"",B2&A2)
If you do want to sort your results column, there's just 2 extra steps (this is kind of unnecessary, but if you want to present / print your data in some format, you will need to either do this or manually copy + paste values):
Add an extra column to the right of the final column from my above response. Here, you want to check to see whether your current row is a new filepath + filename, or if it is blank (meaning column A was a filepath). I will assume you used my second option above, using columns B-D.
In column E, starting at E2 and copied down:
=if(B2,B1,B1+1)
If B2 is TRUE, the row is a filepath, and doesn't create a new filename + filepath. Therefore, we can keep the last counter. Otherwise, add a new counter.
In column F, starting at F2 and copied down:
=if(row()-1>max(E:E),"",index(D:D,match(row()-1,E:E,0)))
This looks at your results column, column D, which is unsorted and contains blanks. If the current row number in column F (minus 1 for the header row) is no bigger than the biggest counter in column D, it returns the matching item for that row number from column D.
Hope this helps you in similar situations in the future.

Resources