I want to do a looping where it will filter by few categories. My idea was to set using numbers so it would be easier to loop. My idea
For i = 1 to 5
myTable.AutoFilter Field:=10, Criteria1:=i
....
....
Next i
But I have to declare my categories first, so I thought of doing something like
1 = "MEN"
2 = "WOMEN"
3 = "KIDS BOY"
4 = "KIDS GIRL"
5 = "UNISEX"
But it seems that I cannot do so. So does anyone have any other idea on how to loop filters or know how to declare with integers. Thanks
I'd do something of the likes:
Option Explicit
Sub Filters()
Dim MyFilter As Variant: MyFilter = setArrayFilters
Dim i As Long
For i = LBound(MyFilter) To UBound(MyFilter)
myTable.AutoFilter Field:=10, Criteria1:=MyFilter(i)
Next i
End Sub
Private Function setArrayFilters() As Variant
Dim x As Long: x = 5 'change this to redimension your array
Dim arr(1 To x)
arr(1) = "MEN"
arr(2) = "WOMEN"
arr(3) = "KIDS BOY"
arr(4) = "KIDS GIRL"
arr(5) = "UNISEX"
setArrayFilters = arr
End Function
Related
I'm a beginner of VBA. My problem as title and I really don't know how to correct the code.Below is what I try but I think it's all wrong... Thanks in advance.
Sub Try_Click()
Dim i As Integer
Dim n As Integer
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
For i = 1 To n
i = i * (i + 1)
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = i
End Sub
Don't change i in the loop:
Sub Try_Click()
Dim i As Long
Dim n As Long
Dim prod As Long
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
prod = 1
For i = 1 To n
prod = prod * i
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = prod
End Sub
You need to add another variable to calculate it as below:
Sub Try_Click()
Dim i As Integer
Dim n As Integer
Dim k As Long
k = 1
n = ThisWorkbook.Sheets("Sheet2").Cells(3, 2).Value
For i = 1 To n
k = k * (i)
Next i
ThisWorkbook.Sheets("Sheet2").Cells(5, 2) = k
End Sub
As mentioned in comments, I also would have done:
Option Explicit
Public Sub Try_Click()
Dim n As Long
With ThisWorkbook.Sheets("Sheet 1")
n = .Cells(3, 2)
.Cells(5, 2) = Application.WorksheetFunction.Fact(n)
End With
End Sub
You need an additional variable for the result. Because if you change i within the For loop you fail the auto increment of the loop.
Also I recommend to use Long instead of Integer (for result). Why? Because for n > 7 it will already exceed the limits of Integer and throw an overflow error. Long at least lasts until n = 12. For more you will need to use Double but that will result in an approximated result for n > 18.
Option Explicit
Sub MultiplyN()
Dim i As Long
Dim n As Long
n = 10 'ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
Dim result As Long
result = 1
For i = 1 To n
Debug.Print result & " *" & i & "=" 'look this output in the intermediate window
result = result * i
Next i 'auto increments i
Debug.Print result
'ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = result
End Sub
Note that all Debug.Print lines are not needed to calculate but just to illustrate in the intermediate window what happens.
You can use #SJR suggestion in VBA if you don't want to use formula in cell B5:
=FACT(B3)
Code will be:
Sub Try_Click()
With ThisWorkbook.Sheets("Sheet 1").Cells(5, 2)
.FormulaR1C1 = "=FACT(R[-2]C)"
.Value = .Value
End With
End Sub
I need to get a range of cells into an array, which by itself is simple enough:
Dim matchArray As Variant
matchArray = Sheets(lookupSheet).Range("B2:B12000").Value2
This creates a two-dimensional array with one column as the second dimension and if you expand the range to include a second column it creates a two-dimensional array with two columns for the second dimension:
matchArray = Sheets(lookupSheet).Range("B2:C12000").Value2
But what if the two columns aren't next to each other and you don't want the one in the middle?
matchArray = Sheets(lookupSheet).Range("B2:B12000,D2:D12000").Value2
The above would be my best guess but it doesn't work, it only returns the first range specified.
So what I need is a way to return a range cell values into a specific dimension of the array.
I know I could do it by looping through the rows but that would take far too long with the number of rows I'm going to be working with.
You do need a loop -- but loop over VBA arrays rather than individual cells:
Sub Test()
Dim A As Variant, B As Variant, C As Variant
Dim i As Long
B = Sheets(lookupSheet).Range("B2:B12000").Value2
C = Sheets(lookupSheet).Range("D2:D12000").Value2
ReDim A(1 To 11999, 1 To 2)
For i = 1 To 11999
A(i, 1) = B(i, 1)
A(i, 2) = C(i, 2)
Next i
'do stuff with A
End Sub
This should only take a fraction of a second.
You can do it with a ragged array:
Dim var1(1 To 2) As Variant
Dim var As Variant
var = Range("A1:A10").Value2
var1(1) = var
var = Range("c1:c10").Value2
var1(2) = var
MsgBox var1(1)(3, 1)
Here are a couple more ways:
Sub Example1()
Const lookupSheet As String = "Sheet1"
Dim matchArray As Variant, arr1 As Variant, arr2 As Variant
With Sheets(lookupSheet)
arr1 = WorksheetFunction.Transpose(.Range("B2:B12000").Value2)
arr2 = WorksheetFunction.Transpose(.Range("D2:D12000").Value2)
matchArray = WorksheetFunction.Transpose(Array(arr1, arr2))
End With
End Sub
Sub Example2()
Const lookupSheet As String = "Sheet1"
Dim matchArray As Variant
Dim x As Long
With Sheets(lookupSheet)
matchArray = .Range("B2:B12000").Resize(, 2).Value2
For Each v In .Range("D2:D12000").Value2
x = x + 1
matchArray(x, 2) = v
Next
End With
End Sub
Probably no quicker than John Coleman's answer, but I think this does what you want.
Sub x()
Dim matchArray, r As Range
Set r = Sheets(lookupSheet).Range("B2:D12000")
matchArray = Application.Index(r, Evaluate("Row(1:" & r.Rows.Count & ")"), Array(1, 3))
End Sub
could someone please help me with this pretty simple problem I am having. Basically this is a simplified code for more a more complex problem I am trying to solve. I want to be able to output the values I have assigned to a,b,c,d and e in the column b. The values I have used for a,b,c,d and e are taken from cells a1,a2,a3,a4 and a5.
Thanks :)
Sub help()
Dim letters As String
Dim count As Integer
a = Range("a1").Value
b = Range("a2").Value
c = Range("a3").Value
d = Range("a2").Value
e = Range("a3").Value
letters = "abcde"
For count = 1 To Len(letters)
Range("b" & count) = Mid(letters, count, 1)
Next
'HOW DO I OUTPUT THE ASSIGNED VALUES TO a,b,c,d & e RATHER THAN OUTPUTTING LETTERS?'
End Sub
The easiest way is to change your code as follows:
Sub help()
a = Range("a1").Value
b = Range("a2").Value
c = Range("a3").Value
d = Range("a2").Value
e = Range("a3").Value
Range("b1").Value = a
Range("b2").Value = b
Range("b3").Value = c
Range("b4").Value = d
Range("b5").Value = e
End Sub
Alternatively, you could use an array instead of individual variables, e.g.
Sub help()
Dim myArr(1 To 5) As Variant
Dim count As Long
For count = 1 To 5
myArr(count) = Cells(count, "A").Value
Next count
For count = 1 To 5
Cells(count, "B").Value = myArr(count)
Next count
End Sub
That could also be simplified by saying:
Sub help()
Dim myArr As Variant
myArr = Range("A1:A5").Value ' myArr will be a two-dimensional array
Range("B1:B5").Value = myArr
End Sub
Or, as John Coleman suggested in a comment, you could use a Dictionary:
Sub help()
Dim myVars As Object
Dim letters As String
Dim count As Long
Set myVars = CreateObject("Scripting.Dictionary")
myVars("a") = Range("a1").Value
myVars("b") = Range("a2").Value
myVars("c") = Range("a3").Value
myVars("d") = Range("a2").Value
myVars("e") = Range("a3").Value
letters = "abcde"
For count = 1 To Len(letters)
Range("b" & count) = myVars(Mid(letters, count, 1))
Next
End Sub
Simply turn around the assignment you made to the variable and make it go to the cell.
A couple other quick tips:
Also, while VBA doesn't require specific variable declarations, the implicit declared type is always Variant. So it's considered professional practice to declare all variables and always use Option Explicit.
Always define and set references to the workbook and worksheets.
So...
Sub help()
Dim wb as Workbook
Dim ws as Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim a as String
a = ws.Range("A1")
ws.Range("B1") = a
End Sub
Dear stackoverflow community
At work I have to write a macro which should be able to hide rows based on numbers in a column. Those can be multiple ones in one cell and the input should also allow to show more than one number at a time.
for example:
row 1: 20, 30, 15
row 2: 20
row 3: 13, 76
So if I enter 20, 30, it should only show rows 1 & 2)
I usually code with Java / c# and Im new to VBA, so Id really appreciate help:
My plan was to show a input box and split those numbers into an array.
Then i wanna go through each row with a for-Loop, in which i added two for each loops to check if any numbers equal. If not, hide row. If so, show and then i want to exit both for each loops and go to the next row. To exit nested loops, i tried using a do while boolean but it doesnt seem to work.
Right now it only shows the rows with all the input numbers (only row1 in example).
Sub SortingTest()
Dim numbers() As String
myNum = Application.InputBox("Enter BKPS (separate multiples by , )")
numbers = Split(myNum, ",", -1, compare)
'Userinput Vars
Dim row As Integer
row = 1
Dim saveNumber As String
'Looping Vars
Dim existingNum As String
Dim existingNumsArray() As String
Dim checkRows As Long
Dim saveElement As String
Dim done As Boolean
done = False
' Range("B3").Value = 10
' Saves the Input as Array:
For Each Element In numbers
saveNumber = Element
Cells(2, row).Value = saveNumber
row = row + 1
Next Element
Dim b As Integer
Do While done = False
For b = 1 To 100 'hardcoded, should be length of document. b == row;
existingNum = Cells(b, 3).Value
existingNumsArray = Split(existingNum, ",", -1, compare)
' loop thru input numbers
For Each Element In numbers
saveElement = Element
'loop thru given numbers
For Each inputElement In existingNumsArray
If saveElement <> inputElement Then
Rows(b).Hidden = True
ElseIf saveElement = inputElement Then
Rows(b).Hidden = False
done = True
Exit For
End If
Next
Next
Next
Loop
End Sub
Thank you very much for you answer. Yours hid all the rows, so i adjusted it to show them.
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingBKPS()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 2 To UBound(vars)
.Rows(i).EntireRow.Hidden = True
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = False
End With
End Sub
By splitting it up it is very easy to do:
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingTest()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 1 To UBound(vars)
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = True
End With
End Sub
by running this code line by line, it should be pretty much self explaining (also knowing you have already some knowledge in "coding")
Still, if you have any questions, just ask ;)
You can also do it the following way:
Sub SortingTest()
Dim numbers As Variant
Dim RangeCompare As Range
Dim MyRow As Integer
Dim NumFound As Boolean
numbers = Application.InputBox("Please,list the values in this format: " & _
vbCrLf & "{value, value, value, ...}", _
Default:="{#, #, #}", Type:=64)
For MyRow = 1 To Cells(Rows.Count, 1).End(xlUp).row
Set RangeCompare = Range(Cells(MyRow, 1), Cells(MyRow, Columns.Count).End(xlToLeft))
NumFound = False
For Each rCell In RangeCompare
For Each Element In numbers
If rCell = Element Then
NumFound = True
Exit For
End If
Next Element
If NumFound = True Then Exit For
Next rCell
If NumFound = False Then
Rows(MyRow).Hidden = True
End If
Next MyRow
End Sub
I think it's easy to understand but feel free to ask for explanation.
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