i need know to know how
i can add many rows as every time i write in Cell A3 the split data go to row 5 only but i need it go to the row 6 then 7 and so on
i can make 2 conditions:
if the cell A3 content number that number is start with "0" transfer to number column "column E" E5
if the Cell A3 content (( *.com or *.net )) that word transfer to product column "column B" B5
how i can add more delimiters like (//,/,-)?
Sub SplitText1()
Const SourceRange = "A3" ' <-- Source data range, change to suit
Const DestCell = "a5" ' <-- First destination cell, change to suit
Dim a As Variant, cell As Range, i As Long
For Each cell In Range(SourceRange)
a = split(cell.Value, "//")
ReDim Preserve a(0 To 6)
If Val(a(3)) = a(3) Then
a(4) = a(3)
a(3) = Empty
End If
Range(DestCell).Offset(i).Resize(, 6).Value = a
i = i + 1
Next
End Sub
Related
I'm trying to create a user interface for making timing charts.
I have a list of processes and how long each takes.
The user will enter numbers starting at 1 in the cells to the right
I'm trying to do the following:
For any row with a number copy the info from column B and F then paste it into row 39 + whatever number it finds.
This should create a list that is in the correct order in a chart.
I attempted to put together a program that loops through every row of every column in that number entry area.
Sub TimingChart()
Dim rng As Range
Dim cel As Range
Dim col As Range
'x is the variable for row adjustment to determine what cell to paste into
Dim x As Long
'a is the variable for column adjustments
Dim a As Long
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("M4:AG33")
a = -11
'loop columns
For Each col In rng.Columns
'loop rows of that column
For Each cel In col.Cells
'skip cells with nothing in them
If cel.Value = "" Then
'any cell with a number copy the data in row B and row F and
'paste in the chart below the entry field starting in row 40
'the data should copy into row 39 + x putting the operations in order
Else
x = cel.Value
cel.Offset(a, 0).Copy cel.Offset(a, 39 + x)
cel.Offset(a + 4, 0).Copy cel.Offset(a + 4, 39 + x)
cel.Value.Copy cel.Offset(a - 1, 39 + x)
End If
Next
a = a - 1
Next col
End Sub
Edited to reflect removal of "range("
to get the numbers put this in A39 and copy down:
=IFERROR(SMALL($M$4:$AG$33,ROW(A1)),"")
To get the Actions, put this in B29 and copy down:
=IF(A39<>"",INDEX(B:B,AGGREGATE(15,7,ROW($M$4:$AG$33)/($M$4:$AG$33=A39),COUNTIF($A$39:A39,A39))),"")
To get the time, put this in F39 and copy down:
=IF(A39<>"",INDEX(F:F,MATCH(B39,$B:$B,0)),"")
So with data like:
using those formula we get:
If you really want vba then forget using offset and just refer to the column:
Sub TimingChart()
With ThisWorkbook.Worksheets("Sheet1")
Dim rng As Range
Set rng = .Range("M4:AG33")
'loop columns
Dim col As Range
For Each col In rng.Columns
'loop rows of that column
Dim cel As Range
For Each cel In col.Cells
'skip cells with nothing in them
If cel.Value = "" Then
'any cell with a number copy the data in row B and row F and
'paste in the chart below the entry field starting in row 40
'the data should copy into row 39 + x putting the operations in order
Else
'x is the variable for row adjustment to determine what cell to paste into
Dim x As Long
x = cel.Value
.Cells(cel.Row, 2).Copy .Cells(39 + x, 2)
.Cells(cel.Row, 6).Copy .Cells(39 + x, 6)
cel.Copy .Cells(39 + x, 1)
End If
Next cel
Next col
End With
End Sub
I have written this code to add numbers in a column. It is not adding the last cell.
For example if there are three numbers 1, 2 and 3 it will sum up 1 and 2 and ignore value in third cell. When there is a fourth number 1, 2, 3 and 4 it adds 1, 2 and 3.
Sub add()
Dim Rng As Range, a As Integer
Set Rng = Range("b2", Range("b2").End(xlDown))
Counter = Rng.Count
a = 0
For i = 2 To Counter
a = a + Cells(i, "B").Value
Next i
ActiveCell.Value = a
End Sub
Let's say the Counter = Rng.Count gives 4, and you start your i = 2 (possibly to keep title of your column). Your code will not print 4 digits, because you start loop from 2.
The counter should look like this:
Counter = Rng.Count + 1
and it will work
It is because .End(xlDown) - it works like CTRL + downarrow, and ends on the last not empty, or first not empty cell in the column. That's why when you delete value in specific row it will "break" the range. If you want to scan all rows, no matter if it's empty or not use the loop from the first row, and you will get the sum of the whole column range (starting from row 2 of course):
Sub SumWholeColumn()
'give the sum of all numbers in column B, starting from B2
Dim i, a As Long
Dim column, addr As String
a = 0
column = "b"
For i = 2 To Rows.Count
addr = column & i
a = a + Cells(i, "B").Value
Next i
ActiveCell.Value = a
End Sub
If your range is fixed, you can speed up the calculation process by setting the range manually. Otherwise it will scan ALL rows. For example if you know, that your random numbers will not exceed row 1000, then you can use something like this:
Sub SumWholeColumn()
'give the sum of all numbers in column B, starting from B2
Dim i, a As Long
Dim maxRows As Integer
Dim column, addr As String
a = 0
column = "b"
maxRows = 1000
For i = 2 To maxRows
addr = column & i
a = a + Cells(i, "B").Value
Next i
ActiveCell.Value = a
End Sub
Well I think that at the first time I did not understood your point then, I thought you would like to paste numbers in column B from 0 to the last row, starting from the B2 address. If so - this will work:
Sub add()
Dim i, a As Long
Dim column As String
Dim addr As String
a = 0
column = "b"
For i = 2 To Rows.Count
addr = column & i
ActiveSheet.Range(addr).Value = a
a = a + 1
Next i
End Sub
but today I realised that your title "Adding numbers in a column via Excel VBA
" is wrong and probably you are trying to achieve something else (because you are trying to give some value in ActiveCell?) and if so, please correct me:
you have actually some numbers in column B, and you would like to give in the ActiveCell the sum of all those numbers? The answer for this will be:
Sub SumAll()
'give the sum of all numbers in column B, starting from B2
Dim Rng As Range
Dim a, i As Long
Set Rng = Range("b2", Range("b2").End(xlDown))
Counter = Rng.Count + 1
a = 0
For i = 2 To Counter
a = a + Cells(i, "B").Value
Next i
ActiveCell.Value = a
End Sub
You need to use "a" as Long, because Integer is up to 2147483647 and if you fill all rows in the column, starting from 0 and iterate the number by 1 to the last row, and sum the values it will give you 2147319811 - out of the Integer scope.
i value can be Integer (not Long as in my example), because "i" max value will not exceed the scope (Workbook rows are limited to 1048576). You can safely change i to Integer and save some KB's of memory :)
I have excel cell having multiple rows of data with image url.
Now I want to select all images having 1500 value. So basically I want to select row starting with http and ending 1500.jpg.
Please not that in my single cell values are also other than 1500.jpg.Sample data is given below
colorImages': { 'initial': [{"hiRes":"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UL1500_.jpg","variant":"MAIN","lowRes":null},{"hiRes":"https://images-na.ssl-images-amazon.com/images/I/716mECZ9JDL._UL1500_.jpg","thumb":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL._SR38,50_.jpg","large""thumb":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL._SR38,50_.jpg","large":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL.jpg","main":{"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY445_.jpg":[445,117],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY500_.jpg":[500,132],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY550_.jpg":[550,145],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY606_.jpg":[606,160],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY679_.jpg":[679,179],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY741_.jpg":[741,195],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY879_.jpg":[879,231]},
Assuming data is in Column A starting from Cell A2 and all the URLs ending with 1500.jpg needs to be displayed in adjacent columns i.e. same row Column B, Column C, Column D,.... then following might help.
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long, colIndex As Long
Dim rng As Range, cel
Dim X As Long, DotCount As Long
Dim Pat As String, EndPat As String, Parts() As String
Set ws = ThisWorkbook.Worksheets("Sheet3") 'change Sheet3 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get last row with data in Column A
For Each cel In .Range(.Cells(2, 1), .Cells(lastRow, 1)) 'loop through A2 to last cell with data in Column A
colIndex = 1
Pat = "*[!&-;?-[_a-z~=!" & Chr$(1) & "]."
EndPat = "[!&-;?-[_a-z~=!" & Chr$(1) & "]*"
Parts = Split(cel.Value, """") 'split cell value into an array
For X = 0 To UBound(Parts)
If Parts(X) Like "*?.?*" Then
DotCount = Len(Parts(X)) - Len(Replace(Parts(X), ".", ""))
If """" & Replace(Parts(X), "]", Chr$(1)) & """" Like Application.Rept(Pat, DotCount) & EndPat Then
Parts(X) = ""
ElseIf Right(Parts(X), 8) <> "1500.jpg" Then
Parts(X) = ""
Else
cel.Offset(0, colIndex) = Parts(X) 'display URL
colIndex = colIndex + 1
End If
Else
Parts(X) = ""
End If
Next X
Next cel
End With
End Sub
Derived this solution using Function URLs from here.
This is done easily via VBA, but am not expert in that. So I have done some thing for you,just follow the instruction , still it is apply to get only single search entry i.e. means in a cell its find only one 1500.jpg entry.
To get second entry in the same cell you need some effort via change or get substring from the G1 Cell string and repeat the step as explained again.
In A1 Cell, put 1500.jpg
In B1 Cell, put your actual string as you have above
In C1 cell, put formula "=SEARCH(A1,B1)", which find the search 1500 in string
In D1 cell, put formula "=MID(B1,1,C1)", which extract the substring
For E1 we need reverse the string via VBA code - Add Reversestr function (To add this function, see this link)
In F1 cell, put formula "=SEARCH(CHAR(34),E1)", which search " in above reverse string
In G1 cell, put formula "=MID(B1,C1-F1+1,C1)"
Finally you get the string in G1 Cell as "https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._1500.jpg"
For VBa formula, check this links
http://analystcave.com/excel-substring-vba-substring/
I have multiple cells with string like
for. ex cel A1
m2_10cm[0.10],m2_20cm[0.20],m2_5cm[0.05],m3[1.9]
and cell A2
m3_22[2.2],m3_19[1.9]
Hov can i split it to one column like
Column B
Cell 1 m2_10cm[0.10]
Cell 2 m2_20cm[0.20]
Cell 3 m2_5cm[0.05]
Cell 4 m3[1.9]
Cell 5 m3_22[2.2]
Cell 6 m3_19[1.9]
I will be apriciate for any help
Using VBA code in Excel:
note: google how to a command button on the sheet and paste this as the code.
Option Explicit
' note: vbNullString is the same as "" (empty string)
Const START_ROW = 1
Const SRC_COL = 1 ' column A
Const DST_COL = 2 ' column B
' this gets triggered when the button is pressed
Private Sub CommandButton1_Click()
' call the routine
Call Go
End Sub
Function Go()
' assume the button is on the sheet to be processed
Dim ws As Excel.Worksheet
Set ws = Excel.ActiveSheet
Dim srcRow As Integer ' current row being processed
Dim dstRow As Integer ' current row to put result in
srcRow = START_ROW: dstRow = START_ROW
' keep going while column 'A' is not blank
While ws.Cells(srcRow, SRC_COL) <> vbNullString
Call Split(ws, ws.Cells(srcRow, SRC_COL), dstRow)
srcRow = srcRow + 1
Wend
End Function
Sub Split(ws As Excel.Worksheet, srcStr As String, ByRef dstRow As Integer)
If (srcStr = vbNullString) Then
'remove comment if you want blanks at the end
' ex. Apple,Banana,
' will create 3 entries, notice the comma at the end
'ws.Cells(dstRow, DST_COL) = vbNullString
'dstRow = dstRow + 1
Exit Sub
endif
' find ","
Dim pos As Integer
pos = InStr(1, srcStr, ",")
If (pos = 0) Then
' no "," - put the whole string
ws.Cells(dstRow, DST_COL) = Trim(srcStr)
dstRow = dstRow + 1
Else
' has "," - put the left part of the string
' ex: apple,banana,carrot
' put "apple"
' continue processing "banana,carrot"
ws.Cells(dstRow, DST_COL) = Trim(Mid(srcStr, 1, pos - 1))
' move to next row and process the right of the string
dstRow = dstRow + 1
Call Split(ws, Mid(srcStr, pos + 1), dstRow)
End If
End Sub
Here is a solution where you need to have every other column hidden:
Say that you have the value in A1 then put in the following formulas:
B1: =IF(ISERR(FIND(",";A1;1));A1;LEFT(A1;FIND(",";A1;1)-1))
C1: =IF(ISERR(FIND(",";A1;1));"";RIGHT(A1;LEN(A1)-FIND(",";A1;1)))
B1 will then contain the first value in the list, C1 will contain the list minus the first value. Now you can copy these formulas to D1 and E1 and they will now look like
D1: =IF(ISERR(FIND(",";C1;1));C1;LEFT(C1;FIND(",";C1;1)-1))
E1: =IF(ISERR(FIND(",";C1;1));"";RIGHT(C1;LEN(C1)-FIND(",";C1;1)))
Now keep on copying this formulas for as long to the right as you need.
Once this is done you can hide all columns that contain the shortened list, starting with C, then E, etc.
I am currently working on a problem where I have an Excel Spreadsheet that I would like to use a VBA macro on. Each of the following 3 rows are consecutive.
Name of Data
abc A1 B2 B4 C4 E2 F43 d4 V8 f9 k11 j20 … x
cde A2 B3 B12 C6 E9 F34 d6 V4 f13 k111 j209 … x
efg A3 B5 B7 C8 E11 F68 d19 V12 f91 k114 j2014 … x
…
Desired
abc A1 B2 B4 C4 E2 F43 d4 V8
abc f9 k11 j20 …
cde A2 B3 B12 C6 E9 F34 d6 V4
cde f13 k111 j209 …
efg A3 B5 B7 C8 E11 F68 d19 V12
efg f91 k114 j2014 …
I have the data name for each row and some rows can be hundreds of entries long spanning hundreds columns. So what I would like to do would be make my row length stop at 8 columns wide. I would hope that the macro can check through each row to see if the length is greater than 8, insert a row with the same data name and paste the next 8 columns, subtract it from the total columns and paste the next row, until it has reached the end of the first long row, and continue checking through all the rows. In essense, it saves a whole lot of time from counting up 8 columns wide, cut and pasting it in an inserted row below, preserving all other data. I'm new to this, so macro or VBA help is much appreciated.
Thanks,
John
The below macro will do exactly as you ask. It has some assumptions that I'll leave to you to fix, such as
Data is in sheet 1
Name column is always A, all data columns start from B
Everything starts in cell A1
This macro will run through every row and, for those rows with more than 9 data elements, it will create a new row and populate it with the previous rows Name and the remaining data rows. It will continue doing this until there is less than or equal to 8 data elements per row.
Since you have MANY rows you say, it would be a good idea to turn off screen updating, like so Application.ScreenUpdating = False before the for loop and turn it back on after the for loop.
Public Sub SplitRows()
Dim rowRange As Variant
Dim colCount As Integer
Dim lastColumn As Long
Dim rowCount As Integer
rowCount = Cells(Rows.Count, "A").End(xlUp).Row
Dim i As Integer
i = 1
Do While (i < rowCount)
lastColumn = Sheet1.Cells(i, Columns.Count).End(xlToLeft).Column
colCount = Sheet1.UsedRange.Columns.Count
rowRange = Range(Cells(i, 2), Cells(i, colCount))
'if the row has more than 9 values (name column + 8 data columns)
If Not lastColumn <= 8 Then
Dim x As Integer
'from column 2 (B, aka first data column) to last column
For x = 2 To colCount - 1
'if data is not empty AND x mod 8 is 1 (meaning 8 goes into x enough times to have a remainder of 1)
If Not IsEmpty(rowRange(1, x - 1)) And (x Mod 8) = 1 Then
Cells(i, 1).Offset(1).EntireRow.Insert 'insert new row below current row
rowCount = rowCount + 1 'update row count because we added a row
Sheet1.Cells(i + 1, 1).Value = Sheet1.Cells(i, 1).Value 'set first column name
Dim colsLeft As Integer
For colsLeft = x To colCount - 1
'take data value from col 9 to end and populate newly created row
Sheet1.Cells(i + 1, colsLeft - 7).Value = rowRange(1, colsLeft)
Sheet1.Cells(i, colsLeft + 1).Value = "" 'set data value from col 9 on and set to empty
Next
Exit For 'exit loop, weve done all we need to and must now check the newly populated row
End If
Next
End If
i = i + 1
Loop
End Sub
Here is a before and after of the results:
BEFORE
AFTER
Argh, I tried somewhat along this lines, but I have to go to work. Maybe it is helpful as a starting point.
Public Sub Test()
Dim mastercell As Range
Set mastercell = ActiveWorkbook.Worksheets(1).Cells(1, 1)
Dim masterValue As String
masterValue = mastercell.Value
If GetCount(masterValue) > 8 Then
Dim tempvalue As String
tempvalue = masterValue
Dim Rowcount As Integer
Dim ColCount As Integer
Rowcount = mastercell.Row
ColCount = mastercell.Column + 1
Do While GetCount(tempvalue) > 8
Dim WriteValue As String
WriteValue = GetFirstEight(tempvalue)
ActiveWorkbook.Worksheets(1).Cells(Rowcount, ColCount).Value = WriteValue
ColCount = ColCount + 1
tempvalue = Replace(tempvalue, WriteValue, 0, 1)
Loop
End If
End Sub
Private Function GetCount(str As String) As Integer
Dim Splitter As String
Splitter = " "
Dim SplitArray As Variant
SplitArray = Split(str)
GetCount = UBound(SplitArray)
End Function
Private Function GetFirstEight(str As String) As String
Dim i As Integer
Dim NewString As String
Dim SplitArray() As String
SplitArray = Split(str)
For i = 0 To 7
NewString = NewString & SplitArray(i) & " "
Next
GetFirstEight = NewString
End Function