I've built a name range for 20 cells so that I can input a new list of projects which will vary from 1 to 20. I want to write a macro so that it reads the number of projects and creates the correct number of tabs, and names the tab after the project name listed in the named range. I've done all of this except I can't get the countA function to work. The named range is csCount. if I change the For loop to the correct number in one instance (if I put 7 because right now I have 7 projects) the loop and macro are correct. I want to make it more dynamic using the countA. Thank you very much for the help.
Sub generateDepartments()
Dim tabs As Integer
Dim sName As String
Dim i As Integer
Dim j As Integer
Dim csCount As Variant
tabs = Application.CountA(csCount)
j = 5
i = tabs
For i = 2 To Application.CountA(csCount)
Worksheets("Input").Activate
sName = Cells(j, 3).Value
Worksheets.Add(after:=Worksheets(i)).Name = sName
j = j + 1
Next
End Sub
First you need to create a variable to access your named range: Set csCount = ActiveWorkbook.Names("csCount").RefersToRange or Set csCount = ActiveSheet.Range("csCount")
Then use Application.WorksheetFunction.CountA(csCount)
Also, is better to define as a Range instead of Variant Dim csCount As Range
Related
I am trying to loop through a named range in Excel and set its value equal to another named range that is dynamic in value (called SensitivityResults). How do I get Excel to essentially say:
Range("Scenario1").Value = Range("SensitivityResults").Value
Range("Scenario2").Value = Range("SensitivityResults").Value
Range("Scenario2").Value = Range("SensitivityResults").Value
etc...
My code as follows does not work:
Dim i As Integer
Dim s As Integer
For i = 1 To 20
For s = 1 To 20
Range("Active_Scenaro") = s
Calculate
Range("Scenario(i)").Value = Range("SensitivityResults").Value
Next s
Next i
You just need to append the counter i as string to your fixed name Scenario:
Range("Scenario" & i).Value = Range("SensitivityResults").Value
I have a data of some binary numbers in few range of cells, from A2 to A8, B2 to B8, and so on, till G column.
Now, I want to check the largest binary number from the above Rows and paste it to the cell, two row below the last used range. (i.e., Largest binary number from Row A to be paste in A10, and so on).
I am not finding any function which can find the value of binary numbers, and the code which I ran finds out the max number considering those as natural numbers.
Your help will be appreciated.
Thank You!
Okay first i made a function that converts binary to decimal and stored in a module. (You can store it wherever you want) This function handles any size binary
Function BinToDecConverter(BinaryString As String) As Variant
Dim i As Integer
For i = 0 To Len(BinaryString) - 1
BinToDecConverter = CDec(BinToDecConverter) + Val(Mid(BinaryString, Len(BinaryString) - i, 1)) * 2 ^ i
Next
End Function
Afterwards i made the sub that loops through all binarys on sheet1 (Might need to change this for your sheet)
Sub FindLargestBinary()
On Error Resume Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Application.ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim tempVal, tempRow As Integer
Dim iCoulmn, iRow As Integer
For iCoulmn = 1 To 7 'Run from A to G
tempRow = 2
tempVal = 0
For iRow = 2 To 8 'Run from row 2 to 8
If BinToDecConverter(ws.Cells(iRow, iCoulmn).Value) > tempVal Then tempVal = BinToDecConverter(ws.Cells(iRow, iCoulmn).Value): tempRow = iRow ' Check if current binary i higher then any previous
Next iRow
ws.Cells(iRow + 1, iCoulmn).Value = ws.Cells(tempRow, iCoulmn).Value 'Print highest binary
Next iCoulmn
End Sub
Hope this helps you out..
You can use the excel function Bin2Dec to change them into decimal
Function MaxBin(r as range)
Dim curmax as long
Dim s as range
For each s in r
If Application.WorksheetFunction.Bin2Dec(s.Text) > curmax Then curmax = Application.WorksheetFunction.Bin2Dec(s.Text)
Next s
MaxBin = curmax
End Function
Assuming your binary values are text strings this formula converts the values to numbers, finds the MAX and then converts back to a text string
=TEXT(MAX(A2:A8+0),"00000")
confirmed with CTRL+SHIFT+ENTER
or you can use this version which finds the max using AGGREGATE function and doesn't require "array entry"
=DEC2BIN(AGGREGATE(14,6,BIN2DEC(A2:A8+0),1))
I'm trying to write a macro that allows a user to enter a new banknote serial number. The macro requires 3 inputs (currency, denomination and serial number). I'm a beginner to VBA, but the code I tried to write is below. Can anyone point out where I went wrong, or what needs to be changed to make it work? Thanks!
Sub TestSub()
Dim Note_Serial As Variant
Dim Note_Currency As Variant
Dim Note_Denomination As Variant
'Defining 3 inputs
Note_Currency = InputBox("Enter Currency (in 3 letter form):")
Note_Denomination = InputBox("Enter Note Denomination (with $ sign):")
Note_Serial = InputBox("Enter Serial Number:")
'Getting 3 inputs
Dim Currency_Cell As Range
Dim Denomination_Cell As Range
Dim Serial_Cell As Range
'Defining cells to write inputs
Currency_Cell = (D3)
Denomination_Cell = (E3)
Serial_Cell = (F3)
'Starting cells
Currency_Cell = Note_Currency
Denomination_Cell = Note_Denomination
Serial_Cell = Note_Serial
'Writing inputs to spreadsheet
Currency_Cell.Offset (1)
Denomination_Cell.Offset (1)
Serial_Cell.Offset (1)
'Moving all cells down 1 place
End Sub
Instead of writing Currency_Cell = (D3), you want to write Set Currency_Cell = Range("D3") (Assuming that you don't switch the active Worksheet).
EDIT: To prevent overwriting previously entered data, use instead:
Set Currency_Cell = Cells(Rows.Count, Range("D3").Column).End(xlUp).Offset(1, 0)
This will select the first empty Cell in Column D.
To move the cell reference, you have to also use the Set keyword, and give the offset in rows and columns:
Set Currency_Cell = Currency_Cell.Offset (1, 0)
I currently have a method which takes in a dynamic named range in excel and converts it to a 2D array.
I need to do some iterations to the data and carry out a Delete function if a certain column contains a value. I have looked at the options out there for deleting rows in 2d array using transpose and temp array and since my data is fairly large I am looking at other data structures that would make it easier to delete entire rows.
I want to convert a dynamic named range into a collection in vba. This collection will have a key the row number and as item should have all the data for that row. Basically I would need the ability to iterate through each value in that range like I can do with a 2D array but also the ability to delete a row efficiently and with less hassle than using a 2D array.
Anybody have an idea on how I can achieve this?
Dim srcArray () As Variant
Dim srcRange As Range
srcRange = ThisWorkbook.Worksheets("Main").Range("myNamedRange")
srcArray = srcRange.Value
Dim rowNr As Long
dim colNr As Long
for rowNr = 1 to UBound(srcArray,1)
if srcArray(rowNr, 9) = "testString" Then Call DeleteRowSub(srcArray, rowNr)
Next rowNr
DeleteRowSub will be a sub which will delete a given row based on the index of that row. I want to get away from that and just be able to say something like srcCollection.Remove(index) with index being the row nr.
Any help, greatly appreciated.
There's no secret to this. It's just housekeeping.
Function ReadRangeRowsToCollection(r As Range) As Collection
Dim iRow As Long
Dim iCol As Long
Dim rangeArr As Variant
Dim rowArr As Variant
Dim c As Collection
'Read range content to Variant array
rangeArr = r.Value
'Now transfer shit to collection
Set c = New Collection
For iRow = 1 To r.Rows.Count
ReDim rowArr(1 To r.Columns.Count)
For iCol = 1 To r.Columns.Count
rowArr(iCol) = rangeArr(iRow, iCol)
Next iCol
c.Add rowArr, CStr(iRow)
Next iRow
Set ReadRangeRowsToCollection = c
End Function
Example usage:
Dim c As Collection
Set c = ReadRangeRowsToCollection(Range("myNamedRange"))
c.Remove 1 ' remove first row from collection
Note: I haven't looked at edge cases; for example this will fail if the range is one cell only. Up to you to fix it.
I have for example a column of 18000 domains and another list with 210.000 domain which those 18000 domains can be found. I need to do smth like CTRL + H, for find and replace, and in the find field I need to add the entire 18000 domains: smth like * domain1.com *, * domain2.com *, * domain3.com * and replace them with blank space. Tried this with find and replace from excel but it doesn't work to add more than 1 value in the Find field. How can i do it for multiple values?
VBA solution
You will need to change the two sheet references (data and edit sheet) data = source, edit = destination. I've also set the replace string to a variable so you can change this from an empty string if required.
If you need any other logic (ie Trim the strings before compare or a change to the strings case comparison) the code should be reasonably easy to tweak.
Hope this helps.
Sub ReplaceValues()
Dim dataSht As Worksheet
Dim editSht As Worksheet
Dim dataRange As Range
Dim dataColumn As Long
Dim editColumn As Long
Dim dataEndRow As Long
Dim editEndRow As Long
'sheet that holds all the values we want to find
Set dataSht = Sheet2
'sheet we want to edit
Set editSht = Sheet1
Dim replaceValue As String
'replace value is empty string
replaceValue = ""
'set the column of the data sheet to A
dataColumn = 1
'set the colmun of the sheet to edit to A
editColumn = 1
dataEndRow = dataSht.Cells(dataSht.Rows.count, dataColumn).End(xlUp).Row
editEndRow = editSht.Cells(editSht.Rows.count, editColumn).End(xlUp).Row
'this is the range of the data that we're looking for
Set dataRange = dataSht.Range(dataSht.Cells(1, dataColumn), dataSht.Cells(dataEndRow, dataColumn))
Dim count As Long
Dim val As String
For i = 1 To editEndRow
val = editSht.Cells(i, editColumn).Value
count = Application.WorksheetFunction.CountIf(dataRange, val)
If count > 0 And Trim(val) <> "" Then
editSht.Cells(i, editColumn).Value = replaceValue
End If
Next i
End Sub
You can use wildcards with find/replace. So in your situation you should be able to use something like
domain* in the find what Field and nothing in the Replace field