So I'm aware that Sheets2!A:A Refers specifically to the whole of column A within the Sheet 2 workbook.
However, how do you actually process this when it's passed through a function?
Function Function1(cellValue As Variant, cellList As Range) As Variant
Dim cellContent As Variant
Dim list As Range
Dim i As Integer
cellContent = Sheets("Sheet1").Range(CStr(cellValue)).Value2
list = Range(cellList).Value2
For i = 1 To list
If i = cellContent Then
Function1 = "Found"
Else
Function1 = "Unfound"
End If
Next i
End Function
How would you parse Sheets2!A:A so that it uses the sheet specified and then the range of values in A:A.
I'm using a function so therefore it's effectively being passed through by the user as
=#Function1(A2,Sheet2!A:A)
the range is already a range:
Function Function1(cellValue As range, cellList As Range) As Variant
Dim cellContent As Variant
Dim list As Variant
Dim i As Long
cellContent = cellvalue.Value2
list = intersect(cellList.parent.usedrange,celllist).Value2
Function1 = "Unfound"
For i = 1 To ubound(list,1)
If list(i,1) = cellContent Then
Function1 = "Found"
Exit Function
End If
Next i
End Function
But this just reinvents MATCH:
=IF(ISNUMBER(MATCH(A2,Sheet2!A:A,0)),"Found","Unfound")
Related
I'm a newbie in the programming world and I'm currently facing a challenge on VBA.
I've built a monthly calendar spreadsheet, and below every day number there is an empty space to be filled depending on some conditions.
I want to fill these spaces with a list of names, depending if the person has the value of Active or not. Another imposed condition is if the date of the calendar is a holliday the cell will remain an empty space, therefore I did a list of hollidays to test this condition.
Here goes the code i made so far:
Sub teste()
line_fill = 5
line_names = 3
column_names = 17
column_active = 18
For i = 6 To 10
Dim values As Worksheets("Planilha1").Cells(5, i))
Dim test As Worksheets("Planilha1").Cells(line_fill - 1, i)
Dim names As Worksheets("Planilha1").Cells(line_names, column_active)
Dim active As Worksheets("Planilha1").Cells(line_names, column_names)
If IsEmpty(test) And test.value <> WorksheetFunction.VLookup(test.value, Sheet1.Range("M4:M100"), 1, False) Then
If names.value = "Ativo" Then
values = active
line_names = line_names + 1
i = i + 1
Next i
End Sub
Image of the spreadsheet
Link to the spreadsheet I'm using
Please try to step through the code with F8 so you understand what I did and try to adjust it to fit your needs.
This is the setup I used to code it:
And this is the code:
Option Explicit
Public Sub CopyValuesInCalendar()
Dim targetSheet As Worksheet
Dim calendarRange As Range
Dim holidaysRange As Range
Dim teamRange As Range
Dim evalDayCell As Range
Dim teamFilteredList As Variant
Dim holidayLastRow As Long
Dim teamLastRow As Long
Dim counter As Long
Set targetSheet = ThisWorkbook.Worksheets("Planilha1")
targetSheet.AutoFilterMode = False
Set calendarRange = targetSheet.Range("D4:J13")
holidayLastRow = targetSheet.Cells(targetSheet.Rows.Count, 12).End(xlUp).Row
teamLastRow = targetSheet.Cells(targetSheet.Rows.Count, 16).End(xlUp).Row
Set holidaysRange = targetSheet.Range("L4:N" & holidayLastRow)
Set teamRange = targetSheet.Range("P3:Q" & teamLastRow)
teamFilteredList = GetActiveTeamMembers(teamRange)
For Each evalDayCell In calendarRange.Cells
If IsNumeric(evalDayCell.Value) And evalDayCell.Value <> vbNullString Then
If Not IsHoliday(evalDayCell.Value, holidaysRange) Then
If counter > UBound(teamFilteredList) Then
counter = 1
Else
counter = counter + 1
End If
evalDayCell.Offset(1, 0).Value = GetTeamMemberName(counter, teamFilteredList)
End If
End If
Next evalDayCell
End Sub
Private Function IsHoliday(ByVal dayNum As Long, ByVal holidayRange As Range) As Boolean
Dim evalCell As Range
For Each evalCell In holidayRange.Columns(1).Cells
If evalCell.Value = dayNum Then
IsHoliday = True
End If
Next evalCell
End Function
Private Function GetActiveTeamMembers(ByVal teamRange As Range) As Variant
Dim evalCell As Range
Dim counter As Long
Dim tempList() As Variant
For Each evalCell In teamRange.Columns(1).Cells
If evalCell.Offset(0, 1).Value = "Ativo" Then
ReDim Preserve tempList(counter)
tempList(counter) = evalCell.Value
counter = counter + 1
End If
Next evalCell
GetActiveTeamMembers = tempList
End Function
Private Function GetTeamMemberName(ByVal counter As Long, ByVal teamFilteredList As Variant) As String
GetTeamMemberName = teamFilteredList(counter - 1)
End Function
Let me know if it helps.
Is there any possible way to take a list of items or names, such as:
Apples
Oranges
Grapes
Watermelons
And have Excel double that information and sequentially number it, like this:
Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2
I know a little bit of VBA but I can't wrap my head around how I would even start this.
You can specify where you want to read, and where you want to start write and how many times you want to repeat!
Just change the code:
Sub DoRepeat()
Dim repeatTimes As Integer
Dim rng As Range, cell As Range
repeatTimes = 2
Set cellsToRead = Range("A1:A3")
Set cellStartToWrite = Range("B1")
For Each cell In cellsToRead
For i = 1 To repeatTimes
cellStartToWrite.Value = cell.Value + CStr(i)
Set cellStartToWrite = Cells(cellStartToWrite.Row + 1, cellStartToWrite.Column)
Next
Next cell
End Sub
As it seems it is required to have a more dynamic approach, try this out. The DoubleNames function will return the names duplicated N number of times specified in the DuplicateCount parameter. It will return a Collection, which you can easily dump to a range if need be.
Public Function DoubleNames(ByVal DataRange As Excel.Range, DuplicateCount As Long) As Collection
Set DoubleNames = New Collection
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim DataItem As Excel.Range
Set DataRange = DataRange.SpecialCells(xlCellTypeConstants)
For Each DataItem In DataRange
For i = 1 To DuplicateCount
If Not dict.Exists(DataItem.Value) Then
DoubleNames.Add (DataItem.Value & "1")
dict.Add DataItem.Value, 1
Else
dict(DataItem.Value) = dict(DataItem.Value) + 1
DoubleNames.Add (DataItem.Value & dict(DataItem.Value))
End If
Next
Next
End Function
Sub ExampleUsage()
Dim item As Variant
Dim rng As Range: Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:A5")
For Each item In DoubleNames(rng, 5)
Debug.Print item
Next
End Sub
I would start by writing a general function that outputs the names (passed as a variant array) a given number of times:
Public Sub OutputNames(ByVal TimesToOutput As Integer, ByRef names() As Variant)
Dim nameIndex As Integer, outputIndex As Integer
For nameIndex = LBound(names) To UBound(names)
For outputIndex = 1 To TimesToOutput
Debug.Print names(nameIndex) & outputIndex
Next outputIndex
Next nameIndex
End Sub
Here you can see the sub that tests this:
Public Sub testOutputNames()
Dim names() As Variant
names = Array("Apples", "Oranges", "Grapes", "Watermelons")
OutputNames 2, names
End Sub
which gives you this output:
Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2
I have range of cells in excel like
A A A B B B
A1 A2 A3 B1 B2 B3
Is there any idea how to convert this range of cell into -
A B
A1 B1
A2 B2
A3 B3
I tried to do it with Kutools addon in excel but it can't solve my problem.
I don't mind if I have to use VBA for this.
Use this formula in cell A7. Enter it with CTRL+SHIFT+ENTER combination, then drag below your table.
=IFERROR(INDEX($A$1:$F$2,2,SMALL(IF((A$6=$A$1:$F$1), COLUMN($A$1:$F$1)-MIN(COLUMN($A$1:$F$1))+1, ""),ROWS($A$1:A1))),"")
Here is what I have managed to do, using dictionaries. I am using the following additional functions:
This one loops through the values in the first row and returns the unique ones as array. It will be the "title" of the list:
Public Function getUniqueElementsFromArray(elementsInput As Variant) As Variant
Dim returnArray As Variant
Dim element As Variant
Dim tempDict As Object
Dim cnt As Long
Set tempDict = CreateObject("Scripting.Dictionary")
For Each element In elementsInput
tempDict(element) = 1
Next element
ReDim returnArray(tempDict.Count - 1)
For cnt = 0 To tempDict.Count - 1
returnArray(cnt) = tempDict.Keys()(cnt)
Next cnt
getUniqueElementsFromArray = returnArray
End Function
This one gets the lastRow of a given column:
Function lastRow(Optional strSheet As String, Optional colToCheck As Long = 1) As Long
Dim shSheet As Worksheet
If strSheet = vbNullString Then
Set shSheet = ActiveSheet
Else
Set shSheet = Worksheets(strSheet)
End If
lastRow = shSheet.Cells(shSheet.Rows.Count, colToCheck).End(xlUp).Row
End Function
This one takes a single row range and returns a 1D array:
Public Function getArrayFromHorizontRange(rngRange As Range) As Variant
With Application
getArrayFromHorizontRange = .Transpose(.Transpose(rngRange))
End With
End Function
This is the main "engine":
Option Explicit
Public Sub TestMe()
Dim keyValues As Variant
Dim keyElement As Variant
Dim keyElementCell As Range
Dim inputRange As Range
Dim outputRange As Range
Dim outputRangeRow As Range
Dim colNeeded As Long
Set inputRange = Range("A1:K2")
Set outputRange = Range("A10")
Set outputRangeRow = outputRange
keyValues = getUniqueElementsFromArray(getArrayFromHorizontRange(inputRange.Rows(1)))
For Each keyElement In keyValues
Set outputRangeRow = Union(outputRangeRow, outputRange)
outputRange.value = keyElement
Set outputRange = outputRange.Offset(0, 1)
Next keyElement
For Each keyElementCell In inputRange.Rows(2).Cells
colNeeded = WorksheetFunction.match(keyElementCell.Offset(-1), outputRangeRow, 0)
Set outputRange = Cells(lastRow(colToCheck:=colNeeded) + 1, colNeeded)
outputRange.value = keyElementCell
Next keyElementCell
End Sub
And this is the input and the output:
I have an excel VBA Function that needs to count the cells that are coloured, match a specific string and have another cell blank.
I created it in a test workbook using only a small sample of the data where it worked, but now, when I implement in the main workbook, it returns #Value! I suspect there could be an issue with the string being used, but putting a watch on all my variables shows the function is working as expected but it doesn't actually provide the return value.
Here is the code. Any input will be very much appreciated
Function FundInStarted(rSample As Range, rKRM As Range, rColNum As Range, rArea As Range) As Long
Dim rAreaCell As Range
Dim lMatchColor As Long
Dim lCounter As Long
Dim sKRMMatch As String
Dim lColNumOff As Long
lMatchColor = rSample.Interior.Color
sKRMMatch = rKRM.Value2
lColNumOff = rColNum
For Each rAreaCell In rArea
If rAreaCell.Interior.Color = lMatchColor And rAreaCell.Offset(0, -lColNumOff) = sKRMMatch And rAreaCell.Value = "" Then
lCounter = lCounter + 1
End If
Next
FundInStarted = lCounter
End Function
I am trying to return the columns count on a range, sometimes I need one range, but, sometimes I need more than one range.
I have put in optional ranges so I can choose multiple ranges. If I reference a range in the function prototype that I have not supplied in the spreadsheet I get the #Value! error.
I need a way to check if the optional ranges are null, void empty etc. so I don't have to reference the range.
This is the VBA Function Prototype:-
Function GetColoumnCount(ARange1 As Range, Optional ARange2 As Range, Optional ARange3 As Range, Optional ARange4 As Range) As Integer
Dim Result As Integer
Result = 0
Result = ARange1.Columns.Count ' This works
Result = ARange1.Columns.Count + ARange2.Columns.Count ' This doesn't work
GetColoumnCount = Result
End Function
In my spreadsheet I have to enter this in a cell for the function to work.
=GetColoumnCount(BC34:BK34, BC35:BD35, BE35:BF35, BG35:BH35)
this defeats the purpose of having optional arguments.
Try it like this
Function GetColoumnCount(ARange1 As Range, Optional ARange2 As Range, Optional ARange3 As Range, Optional ARange4 As Range) As Long
Dim Result As Long
Result = 0
Result = ARange1.Columns.Count ' This works
If Not ARange2 Is Nothing Then
Result = Result + ARange2.Columns.Count
End If
GetColoumnCount = Result
End Function
If you use the ParamArray keyword in the arguments you can supply a variable number of arguments.
Public Function GetColumnCount(ParamArray Ranges() As Variant) As Long
Dim lReturn As Long
Dim i As Long
Dim rResult As Range
Dim rArea As Range
'Loop through the Ranges array supplied by ParamArray
For i = LBound(Ranges) To UBound(Ranges)
'Only work with those array members that are ranges
If TypeName(Ranges(i)) = "Range" Then
'Use Union to combine all the ranges
If rResult Is Nothing Then
Set rResult = Ranges(i)
Else
Set rResult = Application.Union(rResult, Ranges(i))
End If
End If
Next i
'Loop through the Areas and add up the columns
If Not rResult Is Nothing Then
For Each rArea In rResult.Areas
lReturn = lReturn + rArea.Columns.Count
Next rArea
End If
GetColumnCount = lReturn
End Function
To use:
=getcolumncount(E2:K18) = 7
=getcolumncount(D4:L14,N4:P14) =12 (9+3)
=getcolumncount(C7:F15,H7:L15,K7:N15) =11 (omits double counting overlap)