I want to use commas within an excel cell whilst keeping commas as the delimiter.
Sub
Dim countStations As Integer
Dim stationI
Dim rawFileArray() As String = File.ReadAllLines(rawFileName)
For Each station In stationsNameList
stationI = stationList(countStations)
For i As Integer = 0 To rawFileArray.Count - 1
If rawFileArray(i).IndexOf(station, 0) <> -1 Then
stationI.rawData += rawFileArray(i) & "," & stationI.stationName & "," & stationI.region & vbNewLine
End If
Next
CreateStationsXLSX(station, countStations)
countStations += 1
Next
End Sub
Sub (ByRef station As String, ByRef countStations As Integer)
Dim fi = New FileInfo("FQR Generator Data\Stations\" & station & ".xlsx")
Using p As New ExcelPackage(fi)
Dim wsQuantity = p.Workbook.Worksheets.Add("Quantity Summary")
Dim wsQuality = p.Workbook.Worksheets.Add("Quality Summary")
Dim wsRaw = p.Workbook.Worksheets.Add("Raw")
Dim wsStation = p.Workbook.Worksheets.Add(station)
Dim currentCell As Integer = 0
Dim stationToLoad As String = stationList(countStations).rawData
'Importing Raw Data into worksheet
wsRaw.Cells("A1").LoadFromText(stationsHeader)
wsRaw.Cells("A2").LoadFromText(stationToLoad)
p.Save()
End Using
'GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "FQR Generator Data\Stations\", station
End Sub
Here is what is entered into excel ...
Actual Output
Here is what is i want entered into excel...
Wanted Output
Don't use LoadFromText, use Value:
wsRaw.Cells("A2").Value = "this,with,commas"
Related
I would like to create the table based on the "Header" name and it's last row of the table.
I could found the Header start address and Length of the table also using some formulas.
For Example:
FindHeaderValue as 14 i.e, $B$14
TableLength as 65, i.e, $V$65
Hence, I would like to create the Table with the range for
$B$FindHeaderValue:$V$TableLength .
Because the FindHeaderValue and TableLength will vary Excel to Excel.
Please help to figure out the solution for the same. Thank you so much in advance.
Sub Test()
Dim sFindHeader As String
Dim oRangeFindHeader As Range, FirstRange As String, LastRange As String
Dim FindHeaderValue As Integer, FindLength As Integer, TableLength As Integer
Dim Ws As Worksheet
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set oRangeFindHeader = Worksheets("8A52").Range("B1:V5000").Find("BBBB", lookat:=xlPart)
sFindHeader = oRangeFindHeader.Address(ReferenceStyle:=xlR1C1)
FindHeaderValue = GetNumber(sFindHeader)
FirstRange = oRangeFindHeader.Address
MsgBox FindHeaderValue
MsgBox FirstRange
FindLength = FindHeaderValue + 2
TableLength = Cells(FindLength, 13).End(xlDown).Row
MsgBox TableLength
Ws.ListObjects.Add(xlSrcRange, Ws.Range("$B$FindHeaderValue:$V$TableLength"), , xlYes).Name = "DefinitionTable"
Ws.ListObjects("DefinitionTable").TableStyle = "TableStyleLight1"
End Sub
Public Function GetNumber(s As String) As Long
Dim b As Boolean, i As Long, t As String
b = False
t = ""
For i = 1 To Len(s)
If IsNumeric(Mid(s, i, 1)) Then
b = True
t = t & Mid(s, i, 1)
Else
If b Then
GetNumber = CLng(t)
Exit Function
End If
End If
Next i
End Function
Variables don't belong inside quotes. Use & to concatenate them into the range address (which doesn't need $ by the way):
Ws.Range("B" & FindHeaderValue & ":V" & TableLength)
I am looping through the worksheets to sumif the amounts that are "C" and "D".
Each tabs have the amounts in column M and whether they are credit or debit in column N, indicated by the letter C or D.
First I am putting the letters C and D on blank cells and trying to sumif these two amounts next to them.
I am getting a type mismatch error at the sumif line and the whole line is highlighted.
At first I thought maybe it was ws = Worksheets(I) causing the problem so I swapped them out with Worksheets(I), but it still did not work.
Sub Sumiftabs()
Dim Filepath As String
Dim UIGFile As Workbook
Dim Column As String
Dim Month As String
Dim Year As Integer
Dim I As Long
Dim TY As Integer
Dim TYLetter As String
Dim T As Long
Dim TreatyYear As Long
Dim WS_Count As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
TreatyYear = Sheets("Control").Range("B7").Value
'On Error Resume Next
For T = TreatyYear To 16 Step -1
TYLetter = WorksheetFunction.VLookup(T, Workbooks("Separate tabs.xlsm").Sheets("Control").Range("H:I"), 2, False)
TY = Sheets("Control").Range("B7").Value
Month = Sheets("Control").Range("B5").Value
Year = Sheets("Control").Range("B4").Value
Filepath = Sheets("Control").Range("B2").Value
Set UIGFile = Workbooks.Open("K:\Ayoon\UIG\" & Year & "\" & Month & "\UIG_NSA_MonYear_TY" & T & ".xls")
WS_Count = UIGFile.Worksheets.Count
For I = WS_Count To 1 Step -1
Set ws = Worksheets(I)
'Direct Premium
UIGFile.Worksheets(I).Range("S4").Value = "C"
UIGFile.Worksheets(I).Range("S5").Value = "D"
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
UIGFile.Worksheets(I).Range("T5").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
Next I
UIGFile.Close savechanges:=True
Next T
Application.ScreenUpdating = True
End Sub
Your SUMIF looks incorrect.
Eg try this instead:
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), "C", ws.Range("M:M"))
I am putting together a basic macro to format a column to include reference letters. For example, one column has 1,2,3 and there is a cell where the user can input some letters and click a button. ABC for example. This when working shall format 1,2,3 to now be ABC1, ABC2, ABC3 etc.
I have achieved this somewhat but it only works for the letter A. See below:
Sub Macro4()
Range("A3:A60").Select
Selection.NumberFormat = Range("k11").Text & "0" & "0" & "0"
End Sub
Here's my attempt. I'm quite certain there is a better way:
Option Explicit
Sub TestMacro()
Dim MyRange As Range
Dim MyReference As Range
Dim MyArray() As Variant
Dim Counter As Long
Dim wf As WorksheetFunction
Dim Cell As Range
Dim val As Integer
Application.ScreenUpdating = False
Set wf = Application.WorksheetFunction
Set MyRange = Range("A3:A60")
For Each Cell In MyRange
val = Application.Evaluate("=MIN(SEARCH({0,1,2,3,4,5,6,7,8,9}," & Cell.Address & "&" & """0,1,2,3,4,5,6,7,8,9""" & "))")
Cell = CInt(Mid(Cell, val, Len(Cell) - val + 1))
Next Cell
Set MyReference = Range("B3")
MyArray = Application.Transpose(MyRange)
For Counter = LBound(MyArray) To UBound(MyArray)
MyArray(Counter) = MyReference & CStr(MyArray(Counter))
Next Counter
MyRange = Application.Transpose(MyArray)
Application.ScreenUpdating = True
End Sub
I am trying to split a string and create a loop for going through the cells in the column.There are a few challenges:
Split works for ActiveCell only.
Loop goes through all cells until LastRow but populates all cells
with split string values from ActiveCell only.
Split of Array starts with i = 0 even though there is Option Base 1
at the beginning of the Module.
How can I change the location of destination (e.g. instead of
splitting string next to existing data, is there an option to manage
column numbers)?
Thank you
Option Explicit
Option Base 1
Sub SplitStringLoop()
Dim txt As String
Dim i As Integer
Dim y As Integer
Dim FullName As Variant
Dim LastRow As Single
ReDim FullName(3)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
txt = ActiveCell.Value
FullName = Split(txt, "-")
For y = 2 To LastRow
For i = 1 To UBound(FullName)
Cells(y, i + 1).Value = FullName(i)
Next i
Next y
End Sub
Chris Nelisen outlined the reasons, I had this code written before he posted, so I'll post it anyway.
Option Explicit
Sub SplitStringLoop()
Dim txt As String
Dim i As Integer
Dim y As Integer
Dim FullName As Variant
Dim LastRow As Single
ReDim FullName(3)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For y = 2 To LastRow
Cells(y, 1).Select
txt = ActiveCell.Value
FullName = Split(txt, "-")
For i = 0 To UBound(FullName)
Cells(y, i + 2).Value = FullName(i)
Next i
Next
End Sub
To address the issues you list
Split acts on the string you pass to it. You are passing the active cell value to it.
You don't update the result of split (FullName) inside the loop. So what else do you expect?
Split Returns a zero-based, one-dimensional array. It says so right there in the help. Option Base 1 specifies the default lower bound, for when you don't specify it in a Dim statement.
You are specifying the column in your code Cells(y, i + 1) (i + 1 in this case). If you want it somewhere else, specify a different column.
this is my sulotion
Public Function CheckEmailsValid(EmailAddresses As String) As Boolean
On Error GoTo Err_1
Dim V_Tempi As Integer
Dim V_Email As Variant
For Each V_Email In Split(EmailAddresses, ";")
V_Tempi = V_Tempi + 1
If CheckEmailValid(V_Email) = False Then
MyMsgBox 2, "Email " & V_Tempi & " Is invalid"
CheckEmailValidFew = False
Exit Function
End If
Next
CheckEmailValidFew = True
Exit_1:
Exit Function
Err_1:
MyMsgBox 2, "Error !!" & vbCr & Err.Number & vbCr & Err.Description
End Function
I want to be able to export a selected range of cells to a .csv file using VBA. What I have come up with so far does the job excellently for cohering selections, but fails misearably when multiple columns are selected.
Here is the code I managed to put together from snippets found on the internet: It also fiddles around with some UI and since my Excel speaks German and I need to have "." as decimal separator instead of "," it tweaks that.
Sub Range_Nach_CSV_()
Dim vntFileName As Variant
Dim lngFN As Long
Dim rngRow As Excel.Range
Dim rngCell As Excel.Range
Dim strDelimiter As String
Dim strText As String
Dim strTextCell As String
Dim strTextCelll As String
Dim bolErsteSpalte As Boolean
Dim rngColumn As Excel.Range
Dim wksQuelle As Excel.Worksheet
Dim continue As Boolean
strDelimiter = vbtab
continue = True
Do While continue = True
vntFileName = Application.GetSaveAsFilename("Test.txt", _
FileFilter:="TXT-File (*.TXT),*.txt")
If vntFileName = False Then
Exit Sub
End If
If Len(Dir(vntFileName)) > 0 Then
Dim ans As Integer
ans = MsgBox("Datei existiert bereits. Überschreiben?", vbYesNo)
If ans = vbYes Then
continue = False
ElseIf ans = vbNo Then
continue = True
Else
continue = False
End If
Else
continue = False
End If
Loop
Set wksQuelle = ActiveSheet
lngFN = FreeFile
Open vntFileName For Output As lngFN
For Each rngRow In Selection.Rows
strText = ""
bolErsteSpalte = True
For Each rngCell In rngRow.Columns
strTextCelll = rngCell.Text
strTextCell = Replace(strTextCelll, ",", ".")
If bolErsteSpalte Then
strText = strTextCell
bolErsteSpalte = False
Else
strText = strText & strDelimiter & strTextCell
End If
Next
Print #lngFN, strText
Next
Close lngFN
End Sub
As I already mentioned the sub works well with coherent selections and also with multiple selected lines, but fails when it comes to multiple columns.
The current output of the sub can be seen on this here picture:
multiple columns failed
As one would expect, I want the .csv-file (or respective .txt-file) to look like this:
multiple columns desired output
How can I achieve the desired behaviour for the last case?
And would someone be so kind to include the links as images? If perceived appropriate, of course.
This might seem a little complex, but your use case isn't very simple...
It does assume that each of the selected areas is the same size, and that they all line up (as either rows or columns)
Sub Tester()
Dim s As String, srow As String, sep As String
Dim a1 As Range, rw As Range, c As Range, rCount As Long
Dim areaCount As Long, x As Long
Dim bColumnsSelected As Boolean
Dim sel As Range
bColumnsSelected = False
Set sel = Selection
areaCount = Selection.Areas.Count
Set a1 = Selection.Areas(1)
If areaCount > 1 Then
If a1.Cells(1).Column <> Selection.Areas(2).Cells(1).Column Then
'areas represent different columns (not different rows)
bColumnsSelected = True
Set sel = a1
End If
End If
rCount = 0
For Each rw In sel.Rows
rCount = rCount + 1
srow = ""
sep = ""
For Each c In rw.Cells
srow = srow & sep & Replace(c.Text, ",", ".")
sep = ","
Next c
'if there are multiple areas selected (as columns), then include those
If bColumnsSelected Then
For x = 2 To areaCount
For Each c In Selection.Areas(x).Rows(rCount).Cells
srow = srow & sep & Replace(c.Text, ",", ".")
Next c
Next x
End If
s = s & IIf(Len(s) > 0, vbCrLf, "") & srow
Next rw
Debug.Print s
End Sub