Does anyone have an idea how to write VBA in Excel to export multiple rows to just one column. Additionally, I would like to add "enter" at the end of each "row". Ideally, this would be exported in .txt, but it would be already great even if it is converted inside the same document.
Thank you!
Edit: For example: I have rows which contain some text/value A1:A5, B1:B5, ... I would need all of These rows to get "moved" in a single column D for instance. So, A1 would go to D1,A2-D2, A3-D3 ... B1 to D7 and so on. After each end (A5, B5, C5,...) I would need an empty cell (when I convert this to .txt it means enter). I hope it is a bit clearer now.
The code below will do what you describe. Use the constants in the beginning to set how many columns and rows that should be moved to one single column, specified by TargetColNo. An empty cell will be added after each scanned column.
If you prefer to save it to a textfile you can use this code and add a text file to add the result in instead of a column.
Sub Rows2OneColumn()
Const StartColumnNo = 1 ' Start at column A
Const EndColNo = 3 ' End at column C
Const StartRowNo = 1 ' Start at row 1
Const EndRowNo = 5 ' End at row 5
Const TargetColNo = 5 ' Put result in column E
Dim source_row As Integer
Dim source_col As Integer
Dim target_row As Integer
target_row = 1
For source_col = StartColumnNo To EndColNo
For source_row = StartRowNo To EndRowNo
Cells(target_row, TargetColNo).Value = Cells(source_row, source_col).Value
target_row = target_row + 1
Next
target_row = target_row + 1 ' leave one cell empty
Next
End Sub
you need add reference Microsoft ActiveX Data Objects 2.8 Library
Set ff = CreateObject("ADODB.Stream")
ff.Type = 2
ff.Charset = "utf-8"
ff.Open
For Each Cell In Range("A1:D5").Cells
ff.WriteText Cell.Value & vbNewLine
Next
path_to_save = ActiveWorkbook.Path
ff.SaveToFile path_to_save & "\test.txt", 2
Related
I have two workbooks. One workbook has the calendar dates(Calendar.xlsm) and the other workbook has only the names(Workingdays.xlsm) of my class students. What i'm trying to do is to match the names in Workingdays.xlsm to Calendar.xlsx . If the match is found then copy the entire row (last filled cell) to Workingdays.xlsm.
So far i'm successful in matching the names in the two workbooks but unable to select the entire row for that matched names.
Sub Obtain_days()
' Open Calendar
Dim calendar_wb As Workbook
Dim calendar_ws As Worksheet
Dim Workdays_ws As Worksheet
Set calendar_wb = Workbooks.Open("C:\Users\XXX1\Desktop\Calendar.xlsx")
Set calendar_ws = calendar_wb.Worksheets("Sheet1")
Set Workdays_ws = Workbooks("Workingdays.xlsm").Worksheets("Sheet1")
' obtain dates
Workdays_ws.Activate
last_rw_Workdays = Workdays_ws.Range("A1000000").End(xlUp).Row
last_rw_calendar = calendar_ws.Range("A1000000").End(xlUp).Row
'last_col_calendar = calendar_ws.Range("XFD3").End(xlToLeft).Column
' loop through names <-------------Sucessful in matching names
For i = 3 To last_rw_Workdays
findval = Workdays_ws.Range("A" & i).Value
For j = 5 To last_rw_calendar
If calendar_ws.Range("A" & j).Value = findval Then
'calendar_ws.Range("C" & last_col_calendar).Copy
calendar_ws.Cells(j, 32).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3).Resize(1, 2) '<---failed in this step, copying irrelevant cell reference
'ActiveSheet.Range((last_rw_calendar, 1),(last_rw_calendar, last_col_calendar)).Copy
Workdays_ws.Activate
'Workdays_ws.Range("B1000000").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next j
Next i
End Sub
Failed to copy the entire row (Till last filed cell). Any help would be much appreciated
Without more details, I believe you actually want:
calendar_ws.Cells(j, 1).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3)
This is assuming the "calendar_ws" row has 25 columns you want to copy over to "Workdays_ws" starting in column "C".
I have an excel file that contains data exported from LTSpice simulations. There are 280 different runs however the data is exported as two columns (time and voltage) with a run cell at the start of a new run. The number of data points in each run varies. Looks something like this:
Run 1/280
Time1 Voltage1
Time2 Voltage2
Run 2/280
Time1 Voltage1
Time2 Voltage2
Time3 Voltage3
Run 3/280
I would like to have the run cells as row and the time and voltage columns beneath them.
Run 1/280 Run 2/280 Run 3/280
Time1 Voltage1 Time1 Voltage1
Time2 Voltage2 Time2 Voltage2
Time3 Voltage3
I haven't found an easy way to do this yet, so any help would be appreciated.
Thanks
Without VBA...
For each row of your input list, you need to identify its type (Run x/xxx header or terminal, voltage pair) and the row and pair of columns in the output where this input row belongs.
In the picture below, columns A and B perform this task. Column A identifies the output column pair and B the output row, where row 0 indicates the header row of the output.
The header row of the output utilises the fact that if an array is sorted in ascending order and has repeated values then MATCH(x,array,0) finds the index of the first element in array equal to x. The cumbersome repetition of the SUMPRODUCT term in the formulae for the other rows is necesssary for the following reason. If there is no matching pair in columns A and B to the current output row and column pair number then the SUMPRODUCT delivers 0 and, unfortunately, the INDEX(array,SUMPRODUCT()) term evaluates to INDEX(array,0) which delivers the first element of array (*) - which is not what is wanted.
You obviously need sufficient helper values in row 1 and column E of the worksheet in the output area - the maximum values of columns B and A, respectively determine the requirements. Oversizing the output (as the picture has done) is not a problem as the formulae in any redundant positions simply evaluate to "".
(*) In fact, for a single column array the formula =INDEX(array,0) evaluates to the array itself. When used as cell formula (rather than being used as an array formula across a range of cells) formula simply picks the first value from array.
Please try this code.
Sub SplitToColumns()
' 16 Sep 2017
Dim WsS As Worksheet ' S = "Source"
Dim WsD As Worksheet ' D = "Destination"
Dim WsDName As String
Dim RunId As String ' first word in "Run 1/280"
Dim RowId As Variant ' value in WsS.Column(A)
Dim Rl As Long ' last row (WsS)
Dim Rs As Long, Rd As Long ' row numbers
Dim Cd As Long ' column (WsD)
WsDName = "RemoteMan" ' change to a valid tab name
Application.ScreenUpdating = False
On Error Resume Next
Set WsD = Worksheets(WsDName)
If Err Then
' create WsD if it doesn't exist:
Set WsD = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WsD.Name = WsDName
Cd = -1
Else
' continue adding new data to the right of existing,
With WsD.UsedRange
Cd = .Columns.Count - 1
If Cd = 1 And .Rows.Count = 1 Then Cd = -1
End With
End If
Set WsS = Worksheets("Remote") ' change to a valid tab name
With WsS
' presume "Run" & Time in column A, Voltage in Column B
' presume: no blank rows
Rl = .Cells(Rows.Count, "A").End(xlUp).Row
RunId = .Cells(2, 1).Value ' row 2 must have the RunId
RunId = Left(RunId, InStr(RunId, " ") - 1)
For Rs = 2 To Rl ' assume data start in row 2 (A1 may not be blank!)
RowId = .Cells(Rs, "A").Value
If InStr(1, RowId, RunId, vbTextCompare) = 1 Then
Rd = 1 ' first row to use in WsD
Cd = Cd + 2 ' determine next columns
End If
WsD.Cells(Rd, Cd).Value = RowId
WsD.Cells(Rd, Cd + 1).Value = .Cells(Rs, "B").Value
Rd = Rd + 1 ' next row to use
Next Rs
End With
Application.ScreenUpdating = True
End Sub
I am quite new in excel macros and need to extract data from entire row, if you select any row. Suppose there is a sheet having following data:
s.no amount account
1 1234 1234
2 2345 6359
If I select 1st row 1 then it gives value of entire row :
1 1234 1234
I have tried a lot to extract value but I am unable to get value.
You will have to loop through the cells in the row and concatenate the values. There is no function that I'm aware of that returns the "value" of the row. For example:
Dim objSheet As Worksheet
Set objSheet = Sheets(1)
Dim intLastCellIndexInRow As Integer
intLastCellIndexInRow = ActiveCell.SpecialCells(xlLastCell).Column
Dim i As Integer
Dim strRowValue As String
For i = 1 To intLastCellIndexInRow
strRowValue = strRowValue & " " & objSheet.Cells(ActiveCell.Row, i)
Next
MsgBox strRowValue
The Value of a row is an array of the values in that Row
RowData = Range("A1:C1").Value
would fill the Array "RowData" the same as the code
RowData = Array(1,1234,1234)
If you wanted a String like what rory.ap had answered, you use Join
'Same Msgbox result as rory.ap's Answer
strRowValue = Join(RowData, " ")
MsgBox strRowValue
So to get a row as a Space (" ") separated string in one line
strRowValue = Join(Range("A1:C1").Value, " ")
Now I put in the Range "A1:C1" because your data is Columns A thru C
The Entire Row 1 is the Code
Rows(1)
But that Includes EVERY Column until the MAX, Which we really don't want in our string or even need to deal with.
Excel can Detect your data by using the .CurrentRegion from a Starting Point. So if we use A1 as our starting point, get the CurrentRegion and then limit it to the first row we'll only get the Columns used.
Cell("A1").CurrentRegion.Rows(1)
'Is Equivalent to Range(A1:C1) on your Data Example
Cell("A1").CurrentRegion.Rows(2)
'Is Equivalent to Range(A2:C2) on your Data Example
I am having a problem with finding duplicates in an excel column that is created via VBscript.
I currently am grabbing data from a DB opening an excel file, placing the data within and then sorting the data alphabetically ascending on column E (if this isn't needed it can easily be removed).
Now the problem that I am faced with is that I am trying to find any duplicates within that column E (Errors).
If there is a duplicate I would like to copy the duplicate and paste it into another sheet (column A) that I have created
Set oWS7 = oWB.Worksheets(7)
oWB.Sheets(7).Name = "Dups"
And in column B of oWS7 I would like to put all the corresponding column C's (accounts) from the original worksheet.
So that there would be a 1 Error to many account's ratio. If there are no duplicates I would like to have them left alone. I'm not sure how clear this is but any questions/help on this would be much appreciated.
Thanks in advance.
I'm going to make the following assumptions:
The content in the worksheet starts in the first row
The first row (and only the first row) is a header row.
There are no empty rows between header row and data rows.
The data is already sorted.
If these assumptions apply the following should work (once you put in the correct sheet number):
Set data = oWB.Sheets(...) '<-- insert correct sheet number here
j = 1
For i = 3 To data.UsedRange.Rows.Count
If data.Cells(i, 5).Value = data.Cells(i-1, 5).Value Then
oWS7.Cells(j, 1).Value = data.Cells(i, 5).Value
oWS7.Cells(j, 2).Value = data.Cells(i, 3).Value
j = j + 1
End If
Next
'How To find Repeted Cell values from source excel sheet.
Set oXL = CreateObject("Excel.application")
oXL.Visible = True
Set oWB = oXL.Workbooks.Open("ExcelFilePath")
Set oSheet = oWB.Worksheets("Sheet1") 'Source Sheet in workbook
r = oSheet.usedrange.rows.Count
c = oSheet.usedrange.columns.Count
inttotal = 0
For i = 1 To r
For j = 1 To c
If oSheet.Cells(i,j).Value = "aaaa" Then
inttotal = inttotal+1
End If
Next
Next
MsgBox inttotal
oWB.Close
oXL.Quit
I need a macro to get some data from an Excel spreadsheet prior to importing it into MySql linking table.
There is a column of charity names and a column with a list of id's separated by commas (these represent charity types)
To for example
Column A
CharityName1
CharityName2
CharityName3
CharityName4
Column B
100, 101,104
(empty)
104
100,105
I would like this to write a new csv file as follows
1,100
1,101
1,104
3,104
4,100
4,105
Thanks in advance for any help
This code will quickly create a csv file c:\temp\dump.csv with this format
[Updated to handle your format
I note that you may have lost data as Excel has applied scientific notation to your fields. For now I have added an ugly workaround to pad out the 0's. Should B2 be a 30 digit field?]
Sub GetEm()
Dim x()
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngE As Long
Dim objFSO As Object
Dim objTF As Object
Dim vArr
Dim vArrElem
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("c:\temp\dump.csv", 2)
x = Application.Transpose(Range("B1", Cells(Rows.Count, "B").End(xlUp)))
For lngCnt = 1 To UBound(x)
lngE = InStr(x(lngCnt), "E")
If lngE > 0 Then
x(lngCnt) = CStr(Replace(Replace(x(lngCnt), ".", vbNullString), "E+", vbNullString) & Application.Rept("0", Right$(x(lngCnt), 2) - lngE + 1))
End If
If Len(x(lngCnt)) > 0 Then
If Len(x(lngCnt)) Mod 3 = 0 Then
For lngCnt2 = 1 To Len(x(lngCnt)) Step 3
objTF.writeline lngCnt & ",'" & Mid$(x(lngCnt), lngCnt2, 3)
Next
End If
End If
Next
objTF.Close
End Sub
I would iterate through the second column and take the values from each cell into an array, lets call it mainArray. (This iterates rows and cols, be warned: How to iterate through a variable-column-length range in Excel using VBA)
Then I would parse until the delimiting ',' and store them in a an array called cellArray with the first value as the numbered cell they were taken from. Then, replace the original cell value in mainArray with the new cellArray. ( String-Manipulation: Split this String delimited by a - character? )
So cell B1 would become cellArray = { 1, 100, 101, 104 } which would be the first value in mainArray. Do this for each cell in column B for the used range.
Then I would create a new csv ( How to create a separate CSV file from VBA? ) and then input the data into it.
To input the data I would loop through each of my saved arrays and store as CellValue = array[0] + ", " + array[i]
Lastly, I would save my new CSV file.