Separate data in excel cells with separator as";" - excel

I have columns in excell with data in format A1=a;b;c and i want to divide it into three cells as B1=a,C1=b & D1=c . Please help

Select your intended cell(s) > Go to Data Menu > Text To Columns > Delimited > Choose semicolon >
Finish

If you are continually pasting information into the A column and you are looking for a formula solution, you could do this
=TRIM(MID(SUBSTITUTE($A1,";",REPT(" ",LEN($A1))),(COLUMNS($B:B)-1)*LEN($A1)+1,LEN($A1)))
That assumes your first bit of Data starts in cell A1 and you are placing your separated values starting in column B. Copy the formula to the right as for as many entries as you have.
The simpler method is to use Excel's text to columns option if it is available to you as pointed out by Ron Rosenfeld.

If you wish to have a VBA solution. Please try this :
Sub Transpose_Q8582()
Dim pasteRng As Range
Dim i As Long
With ActiveSheet
Set pasteRng = .Range("B1:D1")
With .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For i = 1 To .Rows.Count Step 3
pasteRng.Offset(i - 1).Value = Application.Transpose(.Cells(i, 1).Resize(3))
Next i
End With
End With
End Sub
EDIT
There was an oversight in understanding OP requirement. I have revised VBA code to meet OP requirement.
Sub Test1()
Dim values As Variant
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
values = Split(Cells(i, 1).Value, ";")
Cells(i, 1).Offset(0, 1).Resize(1, UBound(values) + 1).Value = values
Next
End Sub

Write this formula in B1 and drag it towards right and for below rows
=IF(COLUMN()=2,LEFT($A1,1),IF(COLUMN()=3,MID($A1,3,1),RIGHT($A1,1)))

Related

Copy rows and paste them as columns in Excel with VBA automatically

I am learning to copy and paste with VBA automatically without overwriting data.
I managed to get a code to copy from rows and paste them as rows.
Now, I want to copy rows (Same way) but paste them as a column each time.
The first line has to start with a date stamp (Each month) and underneath it the amounts. The amounts are being copied from a pivot table which will refresh then each month.
Here is my written code:
Private Sub CommandButton1_Click()
Dim lastrow As Long, ecol As Long
'Stamp from when the data set is (in months)
If Worksheets("Database").Range("A3").Offset(1, 1) <> "" Then
Worksheets("Database").Range("A3").End(xlDown).Select
ActiveCell.Offset(1, 0).FormulaR1C1 = Now
End If
'To check the last filled line on sheet 'Database_Input'
lastrow = Sheet12.Cells(Rows.Count, 2).End(xlUp).Row
'Copy Paste section
For i = 2 To lastrow
Sheet12.Cells(i, 2).Copy
ecol = Sheet14.Cells(3, Columns.Count).End(xlToRight).Offset(0, 1).Column
ecol = Sheet14.Cells(3, Columns.Count).End
Sheet12.Paste Destination:=Sheet14.Cells(3, ecol)
Next i
End Sub
It keeps giving me an error on the following section:
For i = 2 To lastrow
Sheet12.Cells(i, 2).Copy
ecol = Sheet14.Cells(3, Columns.Count).End(xlToRight).Offset(0, 1).Column
ecol = Sheet14.Cells(3, Columns.Count).End
Sheet12.Paste Destination:=Sheet14.Cells(3, ecol)
Next i
Anyone who has an idea how to deal with this? I copied my row --> row code and edited it. Maybe it has to be completely different.
Many thanks!
You are wanting the Column property of the Range, not Columns.
Also, you can transfer the value directly which is slightly more efficient than copying and pasting.
I have made a semi-educated guess as to desired destination range.
For i = 2 To lastrow
ecol = Sheet14.Cells(3, Columns.Count).End(xlToleft).Offset(0, 1).Column 'not columns at the end
Sheet14.Cells(3, ecol).Value = Sheet12.Cells(i, 2).Value
Next i
I didn't even look into your code, if what you want is just transpose version of the data, get your data into an array (range.value will give array) just use a loop to transpose and then assign it to a new range.
If you want them to contain formula use range.formula instead of value. just be sure to care about relative/absolute references.

How to copy/paste the formulas of Row 2 into lower rows IF Column A isn't empty?

I have a sheet where the cells in Column A auto-populate based on user input. Row 1 is the Headers. Row 2 is fully setup from B:JG with formulas as an example. I would like to have a button that runs a script to check Column A of each row, starting with 3, to see if its empty. If Column A is not empty, it should copy the FORMULAS from B2:JG2 and paste them into Columns B:JG on each row. If Column A is empty, I want it to leave the other columns blank.
I'm just diving into VBA, so any help with a script to accomplish is appreciated.
Example: Rows 3-110 have data in Column A, so B2:JG2 FORMULAS get copied into their B:JG columns. All rows after 110 get nothing because Column A is empty.
The button is on a sheet called "HexBox" and the sheet I need to update is "HexClean".
The user enters some info on the "HexBox" sheet and A:A is auto-populated based on their answers. So there could be 10 or 1000 rows in A:A with values and the rest up to 5000 will be "" if not applicable.
This approach simply
Copies the formulas from 2nd row down to the last used row as determined by Column A (one operation). Note that this step is indifferent of blanks in your column. That is handled in the following 2 steps
Loops through Column A and gather up instances of blank rows by adding them to a Union (collection of cells) (0 operations)
Clears the contents of the Union that is built in step 2 (one operation)
This is a more effecient way to go. Copying & pasting the formulas inside your loop one row at a time will lead to a lot of spread sheet operations. This method has a max of 2 operations
Sub HexSub()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("HexClean")
Dim LR As Long, i As Long, ClearMe As Range
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("B2:JG2").Copy
ws.Range(ws.Cells(3, "B"), ws.Cells(LR, "JG")).PasteSpecial xlPasteFormulas
For i = 3 To LR
If ws.Range("A" & i) = "" Then
If Not ClearMe Is Nothing Then
Set ClearMe = Union(ClearMe, ws.Range("A" & i))
Else
Set ClearMe = ws.Range("A" & i)
End If
End If
Next i
If Not ClearMe Is Nothing Then ClearMe.EntireRow.ClearContents
End Sub
If your range will never have blanks followed by more values, then you can just get rid of the loop and everything below it
If the non-blank cells in column A are typed values then SpecialCells should be able to find them quickly.
Sub populateBelow()
Dim frng As Range
With Worksheets("sheet3")
Set frng = .Range(.Cells(2, "B"), .Cells(2, "JG"))
With .Range(.Cells(3, "A"), .Cells(.Rows.Count, "A").End(xlUp))
With .SpecialCells(xlCellTypeConstants, xlTextValues + xlNumbers)
frng.Copy Destination:=.Offset(0, 1)
End With
End With
End With
End Sub
Sub CopyToMany()
Dim xRow As Range, aCel As Range
For Each xRow In ActiveSheet.UsedRange.Rows
If xRow.Row > 2 Then
Set aCel = xRow.Cells(1, 1)
If aCel.Value <> "" Then
ActiveSheet.Range("B2:JG2").Copy Destination:=ActiveSheet.Range("B" & xRow.Row & ":JG" & xRow.Row)
End If
End If
Next xRow
End Sub

Using a Loop to count number of days between TODAY() and date in a cell in VBA

Semi-new to VBA but need help. I have the following code that I am trying to convert into a loop to provide the number of days between today's date and a date found in column A. The number of rows can change based on data entered and want it to stop when the cell in column A is blank. I also want only the value to appear. Any help is greatly appreciated. The below works great for the first row. I believe the loop should appear on row 2 but don't know how to go about it. Thank you in advance.
Range(ActiveSheet.Range("E2"), ActiveSheet.Range("E2").End(xlDown).Select
ActiveCell.FormulaR1C1 = "=SUM(TODAY()-OFFSET(R2C1,0,0,COUNTA(c[-4]),1))"
ActiveCell.Value = ActiveCell.Value
You do not need a loop for this. This will determine the used range in Column A and apply the formula (but only paste value) in the same used range down Column E
Also, notice that you do not need to use .Select, .Active, or .Selection. here. Directly qualify your ranges and you will save yourself trouble down the road. For learning purposes, it is best to act like those lines do not exist :)
Sub DateDif()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LRow As Long: LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("E2:E" & LRow)
.Formula = "=NOW() - A2"
.Value = .Value 'If you want the formula to remain, remove this line
End With
End Sub

Select all data in a column with variable number of rows

I have the example where I want to write a VBA statement which will select all data in a single column, there are no blanks in the column data. The column position will never change e.g. column A, and the data starts in row 3. However the total number of rows in the column will change regularly.
I want the system to dynamically select all the cells in column and then I can run a method against these selected pieces of data.
As an example of performing an action on your range without selecting it:
Public Sub Test()
Dim rColA As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rColA = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))
MsgBox "Column A range is " & rColA.Address 'Delete if you want.
rColA.Interior.Color = RGB(255, 0, 0) 'Turn the back colour red.
rColA.Cells(2, 1).Insert Shift:=xlDown 'Insert a blank row at second cell in range
'So will insert at A4.
'If the first cell in your range is a number then double it.
If IsNumeric(rColA.Cells(1, 1)) Then
rColA.Cells(1, 1) = rColA.Cells(1, 1) * 2
End If
End With
End Sub
Try
Dim LastRow as Long, sht as worksheet
Set sht = ThisWorkbook.Worksheets("My Sheet Name")
LastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
sht.Range("A3:A" & LastRow).Select
Like Darren Bartrup-Cook says, you may not need to select the data, you can almost always perform actions directly which is much faster.
If your column is "isolated" meaning no other nonblank cells touch your data you can use:
Range("firstCellInYourColumn").CurrentRegion.Select
(this works the same way as Ctrl+* from keyboard)
otherwise use:
Range(Range("firstCellInYourColumn"), Range("firstCellInYourColumn").End(xlDown)).Select
both will work if there are really no blanks within your data.
You should also prepend all Range with worksheet expression, I omitted this.

How do I compare dates in one column to a cell in the same row in another column?

I feel like this should be a simple enough task, but I'm not experienced enough with Excel VBA to know how to approach it. Basically I want to look at two cells in a row and do something if they both both have specific dates in them. The two cells will always be in one of two specific columns.
For example, if the date in D2 and I2 both are both earlier than November, then I want to do something to that row and move to the next row. Then, if the date in D3 and I3 both are both earlier than November, then I want to do something to that row and move to the next row. And so on, and so on...
My problem isn't so much about how to do all the steps. It's really about how to go about doing this compare. I know how to select just the cells in those two columns by doing the following:
Union(Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)), _
Range(Cells(2, 9), Cells(Rows.Count, 9).End(xlUp))).Select
But then it occurred to me that I don't know how I would go about comparing the respective cells of both columns. I only know how to loop through each cell of one column.
Any help would be greatly appreciated.
How about just looping through 1 column, then using the Offset method to compare.
Check this:
Option Explicit
Sub CheckTwoCols()
Dim wks As Worksheet, lastrow As Long, rng As Range, cel as Range
Set wks = Sheets(1) 'change sheet reference to suit your needs
With wks
lastrow = .Range("D" & .Rows.Count).End(xlup).Row
Set rng = .Range("D2:D" & lastrow)
For each cel in rng
'column I is 5 columns to the right of column D
If cel < "11/1/2012" and cel.offset(,5) < "11/1/2012" Then
'process code
End If
Next
End With
End Sub

Resources