Im not sure exactly how to explain this in a google search so im not sure if anyone else has asked this.
I have a vba function that takes a range and turns it into a string of comma separated values.
It works like a charm.
Now i want it to only output the first 41 entries, switch down a row and output the next 41 entries in the range.
I cant quite wrap my head around it, it feels like a simple loop but i cant quite get there.
I found the csvrange macro online somewhere :)
Function csvRange(myRange As Range)
Dim csvRangeOutput
Dim entry As Variant
For Each entry In myRange
If Not IsEmpty(entry.Value) Then
csvRangeOutput = csvRangeOutput & entry.Value & ","
End If
Next
csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function
Input range would look like this
Desired output would look like this, one string located in column B each group of 41 values separated on a row, offsetting 1 down each time the function hits the next nr 42.
Something like this:
Option Explicit
Public Sub test()
Debug.Print csvRange(Selection, 41)
End Sub
Public Function csvRange(ByVal myRange As Range, ByVal Columns As Long) As String
Dim csvRangeOutput
Dim iCol As Long
Dim Entry As Variant
For Each Entry In myRange
If Not IsEmpty(Entry.Value) Then
iCol = iCol + 1
csvRangeOutput = csvRangeOutput & Entry.Value
If iCol = Columns Then
csvRangeOutput = csvRangeOutput & vbCrLf
iCol = 0
Else
csvRangeOutput = csvRangeOutput & ","
End If
End If
Next
csvRange = Left$(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function
will turn this data
into comma separated values with 41 columns
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41
42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82
83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123
124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140
Alternative
Public Sub Convert()
Const ColCount As Long = 41
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long
For iRow = 1 To LastRow Step ColCount
ws.Cells(iRow \ ColCount + 1, "B").Value = "'" & Join((WorksheetFunction.Transpose(ws.Range("A" & iRow).Resize(RowSize:=IIf(iRow + ColCount - 1 > LastRow, WorksheetFunction.Max(LastRow Mod ColCount, 2), ColCount)).Value)), ",")
Next iRow
End Sub
Please, test the next code. It will do what (I understood) you need, for as many records you have in column A:A. It should be fast, using arrays and working in memory. The single iteration is for the necessary number of range slices:
Private Sub testStringCSVArray()
Dim sh As Worksheet, arr, nrSlices As Long, LastRow As Long, rngF As Range
Dim rngStart As Range, i As Long, k As Long, h As Long, arrFin
Set sh = ActiveSheet
LastRow = sh.Range("A1").End(xlDown).row
LastRow = sh.Range("A" & rows.count).End(xlUp).row 'last row of A:A
arr = sh.Range("A1:A" & LastRow).Value 'put the range in an array
nrSlices = UBound(arr) \ 41 'determine the number of necessary slices
ReDim arrFin(nrSlices + 1)
Set rngStart = sh.Range("B" & UBound(arr) + 2) 'set the cell where the result to be returned
For i = 1 To nrSlices + 1
arrFin(h) = CStr(Join(Application.Transpose(Application.Index(arr, _
Evaluate("row(" & k + 1 & ":" & IIf(i <= nrSlices, 41 + k, UBound(arr)) & ")"), 1)), ","))
k = k + 41: h = h + 1
Next i
'Format the range where the processed data will be returned and drop the processed data array:
With rngStart.Resize(h, 1)
.NumberFormat = "#"
.Value = WorksheetFunction.Transpose(arrFin)
End With
End Sub
In order to avoid deleting of the already processed data, in case of whishing to run the code twice or more times, the processed data will be returned in column B:B, two rows down from the last cell in column A:A. If after testing, the code proves to be reliable and no need to run it one more time, Set rngStart = sh.Range("B" & UBound(arr) + 2) can be modified in Set rngStart = sh.Range("A" & UBound(arr) + 2).
Without preliminary formatting as text the area where the data will be dropped, Excel changes the NumberFormat in "scientific", when the comma delimited string contains (only) numbers of three digits each. It looks to consider the comma as a thousands separator...
Currently I have data that is already filtered business type. I want to fill an array with the values from another column without any repeats. In other terms I want to fill an array with the filter criteria from another column.
The filter criteria in the other column will change depending on what business type is selected so filling the array needs to be dynamic.
I've researched this online and so far have only found this which doesn't work:
Dim tempArr As Variant
tempArr = Sheets("Sheet1").Filters.Criteria1
Sample Data
buisUnit ProfCenter
SHS 1
SHS 1
SHS 2
SHS 3
SHS 4
ALT 5
ALT 6
ALT 6
ALT 7
So if my data is filtered on buis unit = SHS I would want tempArray = (1,2,3,4)
if filtered on ALT i would want (5,6,7)
Thanks in advance.
Use the next function, please. It needs a reference to 'Microsoft Scripting Runtime'. If you cannot add it (even if it is extremely simple), just comment the first declaration line and un-comment the second one:
Function FilterArray(arr As Variant, strSearch As String) As Variant
Dim dict As New Scripting.Dictionary
'Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long, strKey As String
For i = 1 To UBound(arr)
If arr(i, 1) = strSearch Then
strKey = arr(i, 1) & "|" & arr(i, 2)
If Not dict.Exists(strKey) Then
dict.Add strKey, arr(i, 2)
End If
End If
Next i
If dict.Count = 0 Then FilterArray = "": Exit Function
FilterArray = dict.Items
End Function
It would be called in the next way:
Sub testFilterArr()
Dim sh As Worksheet, arr As Variant, strSearch As String, lastRow As Long
Set sh = ActiveSheet 'use here the necessary sheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
arr = sh.Range("A2:B" & lastRow).Value
strSearch = "SHS"
arr = FilterArray(arr, strSearch)
If IsArray(arr) Then
Debug.Print Join(arr, ",")
Else
MsgBox "No any result for """ & strSearch & """..."
End If
End Sub
I have a problem.
I have this:
("boufous;othman;212544;casa")
I want to split this cell to multiple cells like:
cell[1]=boufous cell[2]=othman cell[3]=212544
cell[4]=casa
For Each olMailItem In olItems
//Code here
i = i + 1
Next olMailItem
There really are two ways that I personally like working through if you must use VBA. Imagine the following data:
1. Split
As per the comments given, you can utilize a function called Split. Hereby a small script which shows how you could approach this involving a small loop:
Sub UseSplit()
Dim arr As Variant
Dim lr As Long, x As Long
With Sheet1 'Change CodeName accordingly
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("A1:A" & lr)
For x = LBound(arr) To UBound(arr)
.Cells(x, 2).Resize(1, UBound(Split(arr(x, 1), ";")) + 1) = Split(arr(x, 1), ";")
Next x
End With
End Sub
2. TextToColumns
A second approach would be to utilize the build-in function to write delimited text to other columns using the TextToColumns function. This would not involve a loop. Underneath a small example:
Sub UseSplit()
Dim rng As Range
Dim lr As Long
With Sheet1 'Change CodeName accordingly
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range("A1:A" & lr)
rng.TextToColumns Destination:=.Range("B1"), Semicolon:=True
End With
End Sub
The advantage with this is that, whereas Split will return an array of string values, text to columns will not:
Values that are meant to be numeric, are actually numeric.
The question remains, do you really need to work through VBA? Either way, good luck with your project =)
Assuming olMailItem as a string and below is the code
Dim str1, str2
olMailItem = "boufous;othman;212544;casa"
str1 = Split(olMailItem, ";")
str2 = UBound(str1)
For i = 0 To str2
Debug.Print str1(i)
Next i
How can I run a loop in VBA so that the sequence looks like in green an pink color?
Because when I use this code is actually just paste all number 1. not increase.
ThisWorkbook.Sheets("Main").Range("E2:E" & iLast).FillDown
This may not be the cleanest way, but it will do the trick.
Sub InsertSequenceAndColours()
Dim ws As Worksheet
Dim rng As Range
Dim iLast As Integer
Dim i As Integer
Dim iSeq As Integer
Dim iColRGB(2, 3) As Integer
Dim iIncremColour As Integer 'used to determine the colour to use
Dim iColour As Integer
'set RGB Colours; change as needed
'colour 0 (green)
iColRGB(0, 1) = 146
iColRGB(0, 2) = 208
iColRGB(0, 3) = 80
'colour 1 (pink)
iColRGB(1, 1) = 255
iColRGB(1, 2) = 225
iColRGB(1, 3) = 236
'change to 0 if you want to start with colour 1 (pink)
iIncremColour = 1
'declare worksheet to work on
Set ws = ThisWorkbook.Worksheets(Sheet1.Name)
With ws
'find last row
iLast = .Cells(.Rows.Count, "C").End(xlUp).Row
'loop through column C
For i = 2 To iLast
iSeq = iSeq + 1
If .Cells(i, 3).Value <> .Cells(i - 1, 3).Value Then
iSeq = 1
iIncremColour = iIncremColour + 1
End If
'assign Seq. No. to cell (column E)
.Cells(i, 5).Value = iSeq
'find if iIncremColor is odd or even. output: 0 or 1
iColour = iIncremColour Mod 2
'assign colour to col C D E
.Range(Cells(i, 3), Cells(i, 5)).Interior.Color = _
RGB(iColRGB(iColour, 1), iColRGB(iColour, 2), iColRGB(iColour, 3))
Next i
End With
End Sub
It finds out the Seq "1" (Col E) by finding the first occurrence of "No" (Col C); Seq "2, 3" are just incremental (so it will work also with more than 3 occurrences).
Same with colour. For each "Seq 1" it increments a number; by checking if this number is odd or even it assign one colour or the other.
Please Note I use worksheet codename to work (if you're not familiar with it, please google it), which I strongly advise since it will work even if you decide to change the name of your worksheet in excel.
When VBA requests to work with worksheet name or index, you can trick it by using codename.Name or codename.Index.
Approach via array
You can fill an array and write it back to your target range:
Sub FlexibleRange()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Main") ' << change to your sheet name
Dim start As Long, last As Long, i As Long ' declare variables
start = 2: last = 100 ' <~~ change to your individual rows
Dim v: ReDim v(start To last, 1 To 1) ' variant datafield array, counter
For i = start To last
v(i, 1) = (i - start) Mod 3 + 1 ' assign values
Next i
ws.Range("E" & start & ":E" & last) = v ' write numbers to column E
End Sub
I got to solve it.
i use this formula
=MOD(ROW()-2,3)+1.
Thank's you all..appreciate your help. <3
I have table like this
Column A Column B
5 25
4 20
8 40
3 15
20 100
I want to use vba script to select last Value from Column A to divide like =A1/last Value Form coumn A*100
Put this in B1 and copy down.
=A1/LOOKUP(2,1/A:A,A:A)*100
If you're looking out for a Solution in Excel-VBA, then here it is..
Sub test()
Dim result As Variant
Dim firstvalue As Variant
Dim secondvalue As Variant
firstvalue = Range("A1").Value
secondvalue = Range("A" & Cells(Rows.Count, 2).End(xlUp).Row).Value
result = (firstvalue / secondvalue) * 100
End Sub
Using VBA. It uses an array which is quick and does the entire column as shown.
Option Explicit
Public Sub DivideByLastValue()
Dim lastRow As Long, arr(), i As Long, divisor As Double
With ThisWorkbook.Worksheets("Sheet1")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
arr = .Range("A1:B" & lastRow).Value
divisor = arr(UBound(arr, 1), 1)
For i = LBound(arr, 1) To UBound(arr, 1)
arr(i, 2) = arr(i, 1) / divisor * 100
Next
.Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub