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

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

Related

vba remove comma without removing strikethough

How am I able to remove the comma without removing the strikethrough format
Example: C418, C419, C420 , C421, C422, C423, C424
Expected Result: C418 C419 C420 C421 C422 C423 C424
Final Result: C418, C419 C420 C421 C422 C423 C424
I am checking to see if that cell contain a strikethrough. By using the Function I am able to detect it. But once I try to remove the comma by using the replace function and replace comma with a blank. The format for the strikethrough will be remove causing the function not to work which will result in a different outcome.
I will like to use the space delimiter to match with the other cell so that I can split the cell value afterwards
If HasStrikethrough(BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB)) = True Then
BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB).Value = Replace(BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB).Value, ",", "")
BOMCk.Sheets("Filtered RO BOM").Range("G" & LCB).Value = "strike-off"
ElseIf HasStrikethrough(BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB)) = False Then
BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB).Value = Replace(BOMCk.Sheets("Filtered RO BOM").Range("B" & LCB).Value, ",", "")
End If
Function HasStrikethrough(rng As Range) As Boolean
Dim i As Long
With rng(1)
For i = 1 To .Characters.Count
If .Characters(i, 1).Font.StrikeThrough Then
HasStrikethrough = True
Exit For
End If
Next i
End With
End Function
Range.Characters only works if the cells value is 255 characters or less.
Range.Characters(i, 1).Delete will delete the commas. Make sure to iterate from the last position to the first position when deleting.
Sub RemoveCommas(ByVal Target As Range)
If Target.Characters.Count > 255 Then
MsgBox "Range.Characters only works with String with 255 or less Characters", vbCritical, "String too long"
Exit Sub
End If
Dim n As Long
For n = Target.Characters.Count To 1 Step -1
If Target.Characters(n, 1).Text = "," Then Target.Characters(n, 1).Delete
Next
End Sub
Alternative via xlRangeValueXMLSpreadsheet Value
The ►.Value(11) approach solves the question by a very simple string replacement (though the xml string handling can reveal to be very complicated in many other cases):
Sub RemoveCommata(rng As Range, Optional colOffset As Long = 1)
'a) Get range data as xml spreadsheet value
Dim xmls As String: xmls = rng.Value(xlRangeValueXMLSpreadsheet) ' //alternatively: xmls = rng.Value(11)
'b) find start position of body
Dim pos As Long: pos = InStr(xmls, "<Worksheet ")
'c) define xml spreadsheet parts and remove commata in body
Dim head As String: head = Left(xmls, pos - 1)
Dim body As String: body = Replace(Mid(xmls, pos), ",", "")
'd) write cleaned range back
rng.Offset(0, colOffset).Value(11) = head & body
End Sub
Help reference links
Excel XlRangeValueDataType enumeration
Excel Range Value

Delete multiple variable columns mentioned in worksheet in VBA

I am trying to delete multiple columns of a newly created workbook stated in the original workbook.
The columns to be deleted are mentioned in one column and the number of column-sequences may be variable.
So far I tried to go through it with a loop which does not work currently. Furthermore, it's not a good practice, since after deletion the rows shift which makes it hard to name the correct columns up for deletion.
Currently, i am receiving an error in the For-next-loop. The Columns-Statement doesn't seem to work.
For your information: I am fairly new to VBA and programming. If you have any more tips or hints reading my code, please give me a sign, I am very happy to improve my VBA-skills.
Sub CleanPlan()
' Define columns up for deletion as variable array
' Use .Transpose to ensure one-dimensional array
Dim DelCol As Variant
DelCol = Application.Transpose(ThisWorkbook.Sheets("Export").Range("B4:B" & Cells(Rows.Count, 2).End(xlUp).Row))
' Open origin file, save as .xlsx
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Export").Range("B1").Value
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\name22.xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Workbooks.Open Filename:=ThisWorkbook.Path & "\name22.xlsx"
' Delete columns from array
Dim i As Integer
For i = 1 To UBound(DelCol)
Columns("""" & DelCol(i) & """").Delete
Next i
' more code, irrelevant at this point
There must be a better practice to solve this issue. I am very thankful for any tips!
Try replacing you loop with this:
Dim i As Integer
Dim x As Long
Dim holdInt As Long
' refactor array to numbers:
For i = 0 To UBound(sortArray)
sortArray(i) = GetColumnNumber(Replace(Left(sortArray(i),2), ":", ""))
Next i
' sort array
For i = 0 To UBound(DelCol)
For x = UBound(DelCol) To i + 1 Step -1
If DelCol(x) < DelCol(i) Then
holdInt = DelCol(x)
DelCol(x) = DelCol(i)
DelCol(i) = holdInt
End If
Next x
Next i
' delete column from right to left
For i=UBound(DelCol) to 0 step -1
Columns(DelCol(i)).Delete
Next i
'-------------------------------------------------
Function GetColumnNumber(text As String) As Long
Dim r As range
Set r = range(Trim(text) & 1)
GetColumnNumber = r.Column
End Function
This will sort you array of columns' numbers, and then will go from end to start so the shift not affect column numbers.
UPDATE
Added a general idea of function to refactor array from Column letters to Column numbers before sort. You need to update to make some checks whether your column letters cover couple of rows (e.g. "A:B", instead of "A:A") or whether if you have columns further than "ZZ:ZZ".

Get the file name into the worksheet same as the order in the folder

I created a code to get the all the file names in the folder into a worksheet.I use this to check the accuracy of the file names(Please see the diagram below).
When I click the macro file names of the destination folder appear under the system reports.Then I use some formulas to match the file names with "Actual Names" column and indicates it to the user.
There is an issue with my code that the order of the file names displaying in the the worksheet is changing day by day though the file names and the order of the files are same in the destination folder.
How do I solve this problem?
Sub GetFiles_Name()
Dim x As String, y As Variant
x = "D:\Reports\*"
y = GetFileList(x)
Select Case IsArray(y)
Case True
MsgBox UBound(y)
Sheets("Cost").Range("H6:H11").Select
Selection.ClearContents
For i = LBound(y) To UBound(y)
Sheets("Cost").Cells(i, 8).Rows("6").Value = y
Next i
Case False
MsgBox "No Matching Files Found!"
End Select
End Sub
Function GetFileList(FileSpec As String) As Variant
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
NoFilesFound:
GetFileList = False
End Function
I can see several problems with your Sub GetFiles_Name():
The variable y is an array, but you're using it as if it was a variable on this line:
Sheets("Cost").Cells(i, 8).Rows("6").Value = y
When you do that, VBA will take the first element of the y array and use it in each column. Has your code actually ever worked as you show in your picture?
By writing Sheets("Cost").Range("H6:H11").ClearContents you assume that your files will always be 6 (from 6 to 11). Is that really the case? I would rather use something more flexible (here I assume that H5 corresponds to your Actual Names header column):
Dim lastRow As Integer: lastRow = Sheets("Cost").Range("G5").End(xlDown).Row
Sheets("Cost").Range("H6:H" & lastRow).ClearContents
Also notice that you don't need to .Select first and then clear the Selection. You can directly .ClearContents on the range without selecting.
Finally, in order not to be dependent on the order of the System Reports column files, you should look for each file and, if matched, just write it close to it. It would look like this:
For i = LBound(y) To UBound(y)
Set matched = Range("G6:G" & lastRow).Find(y(i), LookAt:=xlWhole) '<-- I assume "G" is the column with the file names moving in order
If Not matched Is Nothing Then '<-- if I found the file in the list
matched.Offset(0, 1) = y(i) '<-- put the file name in the adjacent column H
End If
Next i

Compare 2 Cells and Find Missing Values in Excel

I'm currently comparing 2 databases where ZIP codes have been entered manually. I need to compare the ZIP codes for hundreds of accounts in each database to check if anything is missing. I've ordered all the values in ascending order in excel but cant seem to find a quick way to check what's missing.
Column A: Database A ZIPS (The correct ZIPs)
14464, 14515, 14612, 14615, 14626
Column B: Database B ZIPS (Manually Entered)
14464, 14612, 14615, 14626
Column C: Missing ZIPs
14515
EDIT: I should have clarified, the data is stored in this manner.. each zip is not stored in a separate column, there are multiple Zips for each agent.
Image of worksheet
I know there must be a way to find this value using an excel VBA!
Thanks
Answer prior to seeing author's data format
Luckily the task is not too hard. You just need to simply use:
=IF(COUNTIF(list,value),"Output if it exists","Output if missing")
So in your case using the columns you define...
=IF(COUNTIF($B:$B,$A1),"",A1)
Then apply the formula for the length of the correct zip column.
see: https://exceljet.net/formula/find-missing-values
Example picture here
give this a go
Public Function ShowMissingZips(rngSource As Range, _
rngMatch As Range) As String
Dim colSource As Collection
Dim colMatch As Collection
Dim colOutput As Collection
Dim varSource As Variant
Dim varMatch As Variant
Dim varOutput As Variant
Dim intCounter As Integer
Dim blnMatched As Boolean
Dim strSource As String
Dim strMatch As String
Dim strOutput As String
Set colSource = New Collection
Set colMatch = New Collection
Set colOutput = New Collection
strSource = Replace(rngSource.Value, " ", "")
For Each varSource In Split(strSource, ",")
colSource.Add varSource
Next
' Clean up source data
strMatch = Replace(rngMatch.Value, " ", "")
For Each varSource In Split(strMatch, ",")
colMatch.Add varSource
Next
' Clean up match data
For Each varSource In colSource
blnMatched = False
For Each varMatch In colMatch
If varSource = varMatch Then
blnMatched = True
Exit For
End If
Next
' Note if it's not matched
If Not blnMatched Then
colOutput.Add varSource
End If
Next
' Only output if there's anything present
If colOutput.Count > 0 Then
For Each varOutput In colOutput
strOutput = strOutput & CStr(varOutput) & ", "
Next
strOutput = Left$(strOutput, Len(strOutput) - 2)
End If
ShowMissingZips = strOutput
End Function
To use it, press Alt-F11 to get to the VBA editor. Find your workbook in the project explorer (Ctrl-R if not visible) and on the menu at the top click Insert..., Module.
Paste this code in.
Go back to your workbook and assuming that you've kept the columns as before (A, B & C and with row 2 as the first data row), go to cell C2 and type
=ShowMissingZips(A2,B2)
You should see what you're after. It's not pretty and I'd normally add error handling, but it'll do for a quick fix.
When you save it, be sure to use the XLSM format (Excel 2007+) so that the VBA is retained.

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

Resources