when we are going to do a loop in the rows, we can use code like the following:
i = 1
Do
Range("E" & i & ":D" & i).Select
i = i + 1
Loop Until i > 10
but what if we want to do a loop on a column?
Can we use the same method as above?
while the columns in Excel is a complex such as A, B, C, ..., Y, Z, AA, AB, AC, ..., etc.
problems will arise between loop from the "Z" to the "AA".
how we do looping alphabet column from "A" to "Z" and then continued into "AA", "AB" and so on
is there anything that can help?
Yes, let's use Select as an example
sample code: Columns("A").select
How to loop through Columns:
Method 1: (You can use index to replace the Excel Address)
For i = 1 to 100
Columns(i).Select
next i
Method 2: (Using the address)
For i = 1 To 100
Columns(Columns(i).Address).Select
Next i
EDIT:
Strip the Column for OP
columnString = Replace(Split(Columns(27).Address, ":")(0), "$", "")
e.g. you want to get the 27th Column --> AA, you can get it this way
Another method to try out.
Also select could be replaced when you set the initial column into a Range object. Performance wise it helps.
Dim rng as Range
Set rng = WorkSheets(1).Range("A1") '-- you may change the sheet name according to yours.
'-- here is your loop
i = 1
Do
'-- do something: e.g. show the address of the column that you are currently in
Msgbox rng.offset(0,i).Address
i = i + 1
Loop Until i > 10
** Two methods to get the column name using column number**
Split()
code
colName = Split(Range.Offset(0,i).Address, "$")(1)
String manipulation:
code
Function myColName(colNum as Long) as String
myColName = Left(Range(0, colNum).Address(False, False), _
1 - (colNum > 10))
End Function
If you want to stick with the same sort of loop then this will work:
Option Explicit
Sub selectColumns()
Dim topSelection As Integer
Dim endSelection As Integer
topSelection = 2
endSelection = 10
Dim columnSelected As Integer
columnSelected = 1
Do
With Excel.ThisWorkbook.ActiveSheet
.Range(.Cells(columnSelected, columnSelected), .Cells(endSelection, columnSelected)).Select
End With
columnSelected = columnSelected + 1
Loop Until columnSelected > 10
End Sub
EDIT
If in reality you just want to loop through every cell in an area of the spreadsheet then use something like this:
Sub loopThroughCells()
'=============
'this is the starting point
Dim rwMin As Integer
Dim colMin As Integer
rwMin = 2
colMin = 2
'=============
'=============
'this is the ending point
Dim rwMax As Integer
Dim colMax As Integer
rwMax = 10
colMax = 5
'=============
'=============
'iterator
Dim rwIndex As Integer
Dim colIndex As Integer
'=============
For rwIndex = rwMin To rwMax
For colIndex = colMin To colMax
Cells(rwIndex, colIndex).Select
Next colIndex
Next rwIndex
End Sub
Just use the Cells function and loop thru columns.
Cells(Row,Column)
Related
transactions sheet
ID1 Name Amount ID2
123 A 1 0;124;0
456 B 2 124;0;0
789 C 3 456;0;0
transactions sheet (Expected Result)
ID1 Name Amount ID2 Summary
123 A 1 0;124;0 124
456 B 2 124;0;0 456
789 C 3 456;0;0
I have tried text to columns but I am unsure on how to ignore all the 0's and only display the value if its >0 in column D. I am new to vba so would appreciate some advice on this so I can learn.
Code:
Sub SplitRange()
Dim cell As Range
Dim str As Variant 'string array
Dim r As Integer
For Each cel In ActiveSheet.UsedRange
If InStr(cell.Value, ";") > 0 Then 'split
str = Split(cell.Value, ";")
For r = LBound(str) To UBound(str)
cel.Offset(r).Value = Trim(str(r))
If r < UBound(str) Then cell.Offset(r + 1).EntireRow.Insert
Next r
End If
Next cell
End Sub
At first we should not loop through all used cells but only the row where these ID2 are that we need, which is a lot faster.
The easiest way would be just to remove all ;0 and 0; then only the value remains. The following will work if there is always only one real value that is not 0 e.g 0;124;0.
Public Sub FindValueRangeInColumn()
Const Col As Long = 4 'the column where the ID2 is in
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
Dim lRow As Long
lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row 'find last used row in column
Dim iRow As Long
For iRow = 2 To lRow 'loop throug rows from 2 to last used row
Dim strSource As String
strSource = ws.Cells(iRow, Col) 'read value
strSource = Replace(ws.Cells(iRow, Col), ";0", "") 'remove all ;0
If Left$(strSource, 2) = "0;" Then strSource = Right$(strSource, Len(strSource) - 2) 'remove 0; from the beginnning
ws.Cells(iRow, Col + 1).Value = strSource 'write value
Next iRow
End Sub
If there can be more than 1 non-zero value like 0;124;0;222;0;0;144 then replace
ws.Cells(iRow, Col + 1).Value = strSource 'write value
with a splitting alternative …
If InStr(1, strSource, ";") > 1 Then
Dim SplitValues As Variant
SplitValues = Split(strSource, ";")
Dim iValue As Long
For iValue = LBound(SplitValues) To UBound(SplitValues)
ws.Cells(iRow, Col + 1 + iValue).Value = SplitValues(iValue) 'write value
Next iValue
Else
ws.Cells(iRow, Col + 1).Value = strSource 'write value
End If
Morning,
What you need here is to split the entry into an array and then check the values of the array as you loop the array:
Sub SplitString()
Dim TempArray() As String
Dim i as Integer
Dim j As Integer
For i = 1 To 10
TempArray = Split(Worksheets("Sheet1").Cells(i,4).Value,";")
For j = 0 to UBound(TempArray)
If CDbl(TempArray(j)) <> 0 Then
[Output value]
End if
Next j
Next i
End Sub
Create a more useful loop than 1 = 1 to 10 but you get the idea...
Note in the above:
- The CDbl is to ensure that the check reads it as a number and not a text string.
So, you want to concatenate non-0 values into a string, then put that in the next cell?
Sub SplitRange()
Dim workcell As Range
Dim str() As String 'string array
Dim r As Long 'VBA automatically stores Integers as Longs, so there is no Memory saved by not using Long
Dim output As String
output = ";" 'Start with a single delimiter
For Each workcell In Intersect(ActiveSheet.UsedRange,ActiveSheet.Columns(4)) 'Go down the cells in Column D
If InStr(workcell.Value, ";") > 0 Then 'split
str = Split(workcell.Value,";")
For r = LBound(str) To UBound(str)
If inStr(output, ";" & Trim(str(r)) & ";") < 1 Then 'If number is not already in output
output = output & Trim(str(r)) & ";" 'Add the number and ";" to the end of the string
End If
Next r
Erase str 'Tidy up array, ready to recycle
End If
Next workcell
'We now have a unique list of all items, starting/ending/delimited with ";"
output = Replace(output,";0;",";") 'Remove the item ";0;" if it exists
If Len(output) > 2 Then 'output contains at least 1 non-zero number
output= Mid(output,2,len(output)-2) 'Remove ";" from the start and end
str = Split(output,";") 'Split the list of unique values into an array
For r = lbound(str) To ubound(str)
ActiveSheet.Cells(r+2-lbound(str),5).Value = str(r) 'List the values in column 5, starting from row 2
Next r
Erase str 'Tidy up array
End If
End Sub
To remove "0"s from a single row as an Excel formula, try this:
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("|;" & A1 & ";|", ";0;",";"),";|",""),"|;","")
From the inside-out:
SUBSTITUTE("|;" & A1 & ";|", ";0;",";") Sandwich our values in wrappers ("|;0;240;0;|") and replace any ";0;" with ";" ("|;240;|")
.
SUBSTITUTE(PREV,";|","") Remove ";|" ("|;240")
.
SUBSTITUTE(PREV,"|;","") Remove "|;" ("240")
I have an excel table that looks like this:
Row Name
1 uniqueName001_vid1.mpg
2 uniqueName001.mpg
3 uniqueName002_vid1.mpg
4 uniqueName002_vid2.mpg
5 uniqueName002.mpg
I am trying to figure out how to identify and flag(give a unique ID) sets within the table that contain the same uniqueName. For instance Row's 1 and 2 would be one set and Row's 3, 4, and 5 would be another set.
My ideal result is this:
Row Name UID
1 uniqueName001_vid1.mpg SET1
2 uniqueName001.mpg SET1
3 uniqueName002_vid1.mpg SET2
4 uniqueName002_vid2.mpg SET2
5 uniqueName002.mpg SET2
I can run a SQL query in excel if that is better option than excel formula's too.
Any suggestions are greatly appreciated!
If all starts with uniqueNameXXX than it is easy
Row Name UniqueName Unique# UID
1 uniqueName001_vid1.mpg =LEFT(F4;13) =IF(G3<>G4;H3+1;H3) ="UID"&H4
If not, than you should define how to get uniqueName
You can use VBA for that task.
I made a little tool for you. Take care of the editable part
under the declarations.
This tool listens on numbers - means, I expect your pattern to be always the same as you wrote in your question.
Tell me if this helped:
Sub ExtractIdFromString()
Dim strYourColumn As String
Dim intYourStartRow As Integer
Dim intYourLengthOfId As Integer
Dim strYourSetColumn As String
Dim strYourPrefix As String
Dim strString As String
Dim intStringLength As Integer
Dim intStringDigitPosition As Integer
Dim intParserPosition As Integer
Dim strParser As String
Dim i As Integer
Dim strUniqueString As String
Dim rngCell As Range
Dim rngSetCell As Range
Dim strIndex As String
Dim lngCounter As Long
''''editable values''''
strYourColumn = "B" 'Your name column, must be alphabethical
intYourStartRow = 1 'Startrow of your block, must not be 0
intYourLengthOfId = 3 'The amount of digits in your ID, must be > 1
strYourSetColumn = "C" 'The column, where the ID will be inserted, must be numerical (use A = 1, Z = 26)
strYourPrefix = "SET" 'Prefix of your set's ID
''''end of editable values''''
'Set the format of the ID column to text
Range(strYourColumn & ":" & strYourColumn).NumberFormat = "#"
'traverse through the names column
For Each rngCell In Range(strYourColumn & ":" & strYourColumn)
'initialize / reset parser
intParserPosition = 1
'get the actual string to value
strString = rngCell.Value
'End loop on empty cell
If strString = "" Then
GoTo massRename
End If
'get the string's length
intStringLength = Len(strString)
'parse through the string
For intStringDigitPosition = 1 To intStringLength Step 1
'end loop if the string is parsed without a result
If intParserPosition > intStringLength Then
Exit For
End If
'get single digit of the string
strParser = Mid(strString, intParserPosition, 1)
'listen on numbers
If IsNumeric(strParser) Then
'traverse through the expected ID slots
For i = intParserPosition To intParserPosition + intYourLengthOfId - 1 Step 1
'listen for non numerical chars in the expected ID
If Not IsNumeric(Mid(strString, i, 1)) Then
'allow your titles to include numbers
GoTo SkipSingleNumerics
End If
Next
'get the unique prototype of the string
strUniqueString = Mid(strString, 1, intParserPosition + intYourLengthOfId - 1)
'write the unique name in a specified column
Range(strYourSetColumn & rngCell.Row).Value = strUniqueString
End If
'Skip numbers in the string, that dont dont match the ID pattern (optional)
SkipSingleNumerics:
'traverse trough the word
intParserPosition = intParserPosition + 1
Next
Next
'Rename and index equal values
massRename:
lngCounter = 1
'traverse through the set list
For Each rngSetCell In Range(strYourSetColumn & ":" & strYourSetColumn)
'end condition
If rngSetCell.Value = "" Then
Exit For
End If
'store value in variable to save it from overwriting
strIndex = rngSetCell.Value
'start another traversal instance
For Each rngCell In Range(strYourSetColumn & ":" & strYourSetColumn)
'end condition
If rngCell.Value = "" Then
Exit For
End If
'listen if both instances match
If strIndex = rngCell.Value Then
'rename the value
rngCell.Value = strYourPrefix & lngCounter
End If
Next
'increase unique counter
lngCounter = lngCounter + 1
Next
End Sub
tested in Excel 2010
I'm currently struggling with the following problem
I'm trying to implement an input box where a user can input the character of the column.
After that, i dont know how to convert this into a number to use it in the Worksheet.Cells Method
For example: The User inputs "B", so the program saves it in a variable named x and converts it into a number so it can be used as Worksheet.Cells(Row, X)
Is there any method or does someone has an idea how to do this?
Cells() is your friend.
Don't overthink this.
Cells(1, 1) = "jello" ' changes cell A1
Cells(2, "AZ") = "too much jello" ' changes cell AZ2
The second argument of Cells() can be either a number or the alpha column header.
B is the second column, so you can use the expression (based on ASCII):
Sub main()
Dim s As String
s = "AB"
example s
End Sub
Sub example(s As String)
Dim colNum As Integer
Dim i As Integer
i = 1: colNum = 0
While (Mid(s, i, 1) <> "")
colNum = colNum * 26 + (Asc(UCase(Mid(s, i, 1))) - Asc("A") + 1)
i = i + 1
Wend
MsgBox colNum
End Sub
Function getColNum(colLetter As String) As Long
On Error Resume Next 'will return 0 if letter > last col
getColNum = Range(colLetter & "1").Column
End Function
I am trying to compare two columns and if any similar value is there then I want to print that value in a third column. My code is like this:
Sub compare()
Dim arr1 As Range
Dim arr2 As Range
Set arr1 = Range("A1:A6")
Set arr2 = Range("B1:B6")
For Each x In arr1
For Each y In arr2
If x = y Then
Cells(C1).Value = 0
End If
Next y
Next x
End Sub
I am seeing:
Run Time error 1004 Application-defined or object defined error
It is tricky to use For Each when working with an array as you don't know where is in your array the data you are trying to work with. And furthermore, it'll only create duplicate values and you won't be able to interact with your array directly.
Plus, as your loops were sets, you would compare each cell in the first array to each one in the second array. You only need a common factor to loop on.
I added a few tests to avoid some basic issues :
Sub compare()
Dim arr1 As Range, _
arr2 As Range, _
Ws As Worksheet
With Ws
Set arr1 = .Range("A1:A6")
Set arr2 = .Range("B1:B6")
If arr1.Columns.Count > 1 Or arr2.Columns.Count > 1 Then
MsgBox "Too many columns for this simple compare", vbCritical + vbOKOnly
Exit Sub
Else
If arr1.Rows.Count <> arr2.Rows.Count Or arr1.Cells(1, 1).Row <> arr2.Cells(1, 1).Row Then
MsgBox "The ranges don't have the same amout of lines or don't start at the same line", vbCritical + vbOKOnly
Exit Sub
Else
For i = 1 To arr1.Rows.Count
If arr1.Cells(i, 1) <> arr2.Cells(i, 1) Then
Else
.Cells(arr1.Cells(1, 1).Row + 1, _
Max(arr1.Cells(1, 1).Columns, arr2.Cells(1, 1).Column)) _
.Offset(0, 1).Value = arr1.Cells(i, 1)
End If
Next i
End If
End If
End With
End Sub
The short answer is that you need to specify Row and Column when using Cells. The column is 3 for column C so the code to display the matching values should have looked something like this:-
Sub compare()
Dim arr1 As Range
Dim arr2 As Range
Dim count As Integer
Set arr1 = Range("A1:A6")
Set arr2 = Range("B1:B6")
For Each x In arr1
For Each y In arr2
If x = y Then
count = count + 1
Cells(count, 3) = x
End If
Next y
Next x
End Sub
Below one easy way, define one array with one range with 3 columns (two to compare and the 3th to write result)
Sub compare()
Dim Arr() As Variant
Arr = Range("A1:C6")
Dim R As Long
For R = 1 To UBound(Arr, 1)
If Arr(R, 1) = Arr(R, 2) Then
Arr(R, 3) = 0 'or the value of 1th column like arr(r,1)
End If
Next R
Range("A1:C6") = Arr
End Sub
I have an Excel Worksheet consisting of two columns, one of which is filled with strings and the other is emtpy. I would like to use VBA to assign the value of the cells in the empty column based on the value of the adjacent string in the other column.
I have the following code:
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
Dim j As Integer
For j = 1 To 2
If regexAdmin.test(Cells(i, j).Value) Then
Cells(i, j + 1).Value = "Exploitation"
End If
Next j
Next i
The problem is that when using this loop for a big amount of data, it takes way too long to work and, most of the time, it simply crashes Excel.
Anyone knows a better way to this?
You have an unnecessary loop, where you test the just completed column (j) too. Dropping that should improve the speed by 10-50%
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
If regexAdmin.test(Cells(i, 1).Value) Then
Cells(i, 1).offset(0,1).Value = "Exploitation"
End If
Next i
If the regex pattern really is simply "Admin", then you could also just use a worksheet formula for this, instead of writing a macro. The formula, which you'd place next to the text column (assuming your string/num col is A) would be:
=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")
In general, if it can be done with a formula, then you'd be better off doing it so. it's easier to maintain.
Try this:
Public Sub ProcessUsers()
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim r As Range, N As Integer, i As Integer
Set r = Range("A1") '1st row is headers
N = CountRows(r) - 1 'Count data rows
Dim inputs() As Variant, outputs() As Variant
inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
ReDim outputs(1 To N, 1 To 1)
For i = 1 To N
If regexAdmin.test(inputs(i, 1)) Then
outputs(i, 1) = "Exploitation"
End If
Next i
'Output values
r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function