loop using CStr to increment row - excel

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

Related

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,",")

SIMPLE Delete line from cell?

Hello I'm trying to delete all the rows where in column B the members value is over 1000.
I tried this step by step and tried first getting rid of all the unecessary data from B cells and leave just the line with the members.
I noticed there are 5 lines and the members line is the 6'th one. I searched for hours and I still don't get it HOW TO DELETE THE FIRST 5 LINES. Could you please offer me a hand of help? Im sure its soo easy but I cant find it.
I have this:
Option Explicit
Sub Delete5TextLines()
Dim c As Range, s
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
**********
Next c
Application.ScreenUpdating = True
End Sub
this is the .csv file:
http://we.tl/vNcyfg9Wus
Alright, this is not very elegant, but the first thing that I came up with, that kinda works.
use this formula to delete the last word in your bulk of text ("members")
Assuming your text is in A1:
=LEFT(A1,FIND("|",SUBSTITUTE(A1," ","|",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))-1)
This formula gets you the last word of a text, in this case the number of members (because we deleted the word "members)
Assuming you put the formula above in A2
=IF(ISERR(FIND(" ",A2)),"",RIGHT(A2,LEN(A2)-FIND("*",SUBSTITUTE(A2," ","*",LEN(A2)-LEN(SUBSTITUTE(A2," ",""))))))
Now you should have extracted the number of members. If this value is <5000 you can delete the row with a vba loop that should look like this:
Sub deleteRowsAfterMembers
Dim i as Integer
i = ThisWorkbook.Sheets(1).Rows.Count
While i > 0 Do
If (CellWithMemberCount).Value < 5000 Then
ThisWorkbook.Sheets(1).Rows(i).Delete
End If
i = i-1
Loop
End Sub
That'll (hopefully) do it.
Whenever you delete entire rows using a loop, you should start at the bottom of the range and work the loop upwards.
EDIT#1:
Assuming that there are at least five lines within a cell and the lines are separated by Chr(10) then this will remove the first 5 lines:
Sub marine()
ary = Split(ActiveCell.Value, Chr(10))
t = ""
For i = 5 To UBound(ary)
t = t & Chr(10) & ary(i)
Next i
If Len(t) > 1 Then
t = Mid(t, 2)
Else
t = ""
End If
ActiveCell.Value = t
End Sub

excel vba split text

Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub

Skip blank rows when copy range to text file

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

Excel macro - please xplain this code

If data_version < 2.11 Then
Range("A10").Select
Selection.Copy
Range("A17").Select
ActiveSheet.Paste
ActiveCell.FormulaR1C1 = "Resume Path Information"
Range("A12:B12").Select
Selection.Copy
Range("A18").Select
ActiveSheet.Paste
ActiveCell.FormulaR1C1 = "Server Path:"
Range("B18") = ""
Dim formula As String
Dim cu_row As Integer
cu_row = 5
Do
'Fix cell to add resume server path
If Len(Trim(Worksheets("People").Cells(cu_row, ResumeFile).Value)) > 0 Then
formula = "=Process!B$18 & """ & Right(Worksheets("People").Cells(cu_row, ResumeFile).Value, Len(Worksheets("People").Cells(cu_row, ResumeFile).Value) - 2) & """"
Worksheets("People").Cells(cu_row, ResumeFile).formula = formula
'Else be sure it is blank
Else
Worksheets("People").Cells(cu_row, ResumeFile).ClearContents
End If
cu_row = cu_row + 1
Loop Until Worksheets("People").Cells(cu_row, 1) = ""
Range("A1").Select
End If
Well, strictly it doesn't do anything because you've got a trailing End If that doesn't match any earlier If. But ...
It looks at successive rows of the worksheet called "People", starting in row 5 and stopping when it finds a row with nothing in the first column. For each row, it looks in the column whose number is in variable ResumeFile. If there's nothing but whitespace there, it clears it completely. Otherwise, it throws away the first two characters, and interpolates the rest into the magic string Process!B$18 & "VALUE_GOES_HERE", which it stores (as a formula) into the same cell. Here, & performs string concatenation.
Finally, it selects cell A1 for some reason.
So, if that column of the worksheet contained "Fred", "Jim" and "Sheila" before, and if cell B18 of the "Process" worksheet contains "Boo!", then you'll get "Boo!ed", "Boo!m" and "Boo!eila".

Resources