I have a workbook with three sheets (Dash, HT, RV.)
I am trying to write a macro/function that counts how many times a value from 'Dash' exists in a specific column within sheet 'RV' then output that value in a specific cell within 'Dash'
I could go so far as to say that the value within 'Dash' is static and repeat it (The variable from 'Dash' won't ever change as it's a list of Usernames)
In my head it's something like: Count whatever.variable.Dash in column J of sheet.RV print in Dash.B2...
I was able to find a MsgBox option that works, but I have to manually type in each Username (which is a 16character name (string)) then a MsgBox tells me the occurrences. I'm looking to just automate this option with a fixed/static username in the macro/function because the amount of rows in 'RV' can vary between 700 entries to 23k entries
The MsgBox option is:
Dim Count as Integer
Dim Target As String
Dim Cell as Object
Dim N As Integer
Sub Target_Count()
Count = 0
Target = InputBox("character(s) to find?")
If Target = "" Then GoTo Done
For Each Cell in Selection
N = InStr(1, cell.Value, target)
While N <> 0
Count = count + 1
N = InStr(n + 1, cell.Value, target)
Wend
Next Cell
MsgBox count & " Occurrences of " & target
Done:
End Sub
I want the input box target to be 'Dash.A1:8' and the occurrences to be printed in 'Dash.B1:8'
Can you just use a countif() formula rather than programming a macro? say the column you were counting the "dash"'s in was column B in sheet RV, Then in the cell in sheet Dash, the formula would be:
=COUNTIF(RV!B:B,"dash")
Or, if you wanted to vary what you were counting, you simply replace the hardcoded "dash" in the formula with the input cell address.
If you want VBA you can use this. Adjust it however you want.
Sub Target_Count_2()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim Cell As Range
Dim Count As Integer
Dim LastRow As Long
LastRow = wb.Worksheets("RV").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Dim strArr() As Variant
strArr() = wb.Worksheets("RV").Range("J1:J" & LastRow).Value
Dim i As Long
Dim str As String
For Each Cell In wb.Worksheets("Dash").Range("B1:B8")
Count = 0
str = Cell.Offset(, -1).Value2
For i = LBound(strArr) To UBound(strArr)
If str = strArr(i, 1) Then Count = Count + 1
'If InStr(strArr(i, 1), str) > 0 Then Count = Count + 1
Next
Cell.Value2 = Count
Next
Set Cell = Nothing
Set wb = Nothing
End Sub
Note that str = strArr(i, 1) will match only full value in cells, while InStr(strArr(i, 1), str) > 0 will also match parts in cells. Let's say you are looking for "AAA" in cell with the value "AAAB". The first method will not add additional 1 to the Count, while the second method will.
Related
I have two sheets "Data" - which has raw data and "Report" - as Report form .
Report sheet first 5 rows has info.
Data Sheet there 6 columns of Data available (SlNo Name Desig Place gender Category)
Report sheet has first 5 columns only (SlNo Name Desig Place gender)
Report sheet range C5 is dropdown box (List from Category column of Data sheet).
So based on this C5 value get details from Data sheet and paste in Report sheet.
I tried the following code but it pastes the whole row when I want to paste only Name,Desig,Place,gender details in offset and loop...
Sub ViewBtn()
Dim SCHL As String
Dim x As Long
x = 2
Do While Cells(x, 1) <> ""
Sheets("Report").Range(Cells(x, 1).Address, Cells(x, 5).Address).ClearContents
x = x + 1
Loop
Dim id As String
id = ActiveSheet.Range("C5").Value
x = 2
Sheets("Data").Select
Category = id
Do While Cells(x, 1) <> ""
If Cells(x, 4) = Category Then
Worksheets("Data").Rows(x).Copy
Worksheets("Report").Activate
erow = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Report").Rows(erow)
End If
Worksheets("Data").Activate
x = x + 1
Loop
Application.CutCopyMode = False
Worksheets("Report").Activate
End Sub
Here is some sample code to do what I think you are asking for. It is not necessarily the shortest or cleverest way to do it, but everything is done step by step so I hope it is clear enough to follow easily.
Option Explicit
Private Sub viewBtn_Click()
'// Set references to worksheets
Dim wsReport As Worksheet: Set wsReport = Sheets("Report")
Dim wsData As Worksheet: Set wsData = Sheets("Data")
'// Get the category to be reported
Dim sCategory As String
sCategory = wsReport.Range("C5")
'// Reference first line of the report, in row 8
Dim rFirstReportLine As Range
Set rFirstReportLine = wsReport.Range("A8:E8")
'// Reference the line of the report to be written
Dim rReportLine As Range
Set rReportLine = rFirstReportLine
'// Clear the old report area
Do While rReportLine.Cells(1, 1) <> ""
rReportLine.Clear
Set rReportLine = rReportLine.Offset(1, 0)
Loop
'// Reset to first line of the report
Set rReportLine = rFirstReportLine
'// Find the first cell, if any, that matches the category
Dim rMatch As Range
Set rMatch = wsData.Range("F:F").Find(sCategory, , , xlWhole)
'// Get reference to top data row of data sheet, just the cols to be copied
Dim rDataRow As Range: Set rDataRow = wsData.Range("A1:E1")
'// check for at least one match
If Not rMatch Is Nothing Then
'// Save the address of the first match for checking end of loop with FindNext
Dim sFirstMatchAddress As String: sFirstMatchAddress = rMatch.Address
Do
'// 1) .. copy data row to the report line
rDataRow.Offset(rMatch.Row - 1).Copy rReportLine
'// 2) .. move the report line down
Set rReportLine = rReportLine.Offset(1, 0)
'// 3) .. find the next match on category
Set rMatch = wsData.Range("F:F").FindNext(rMatch)
'// 4) .. exit when we have looped around
Loop Until rMatch.Address = sFirstMatchAddress
End If
'// Display the number of entries found at the end of the report
With rReportLine
Dim nEntryCount As Integer: nEntryCount = .Row - rFirstReportLine.Row
.Cells(1, 1) = nEntryCount & IIf(nEntryCount = 1, " Entry", " Entries")
.Font.Italic = True
.Font.Color = vbBlue
End With
'// Make sure the report sheet is displayed
wsReport.Activate
End Sub
With this data
Get this result
I am trying to figure out how to add some cell values together from different sheets but I don't know what the cells references are as they vary!
Basically the values i need will appear 2 rows below some certain text. So I was looking for a formula that searches multiple sheets, finds the specific text, goes 2 rows below then adds the values together.
Here's something I hope you can adapt to your situation by changing the sheet and row and column range, the text to look for, and the destination of the total.
Sub findfvalues()
Dim rowValue
Dim total
total = 0
For r = 1 To 25 'update this to suit your needs
For c = 1 To 25 'update this to suit your needs
If Cells(r, c).Value = "f" Then 'update "f" to search for what you want
rowValue = r + 2
total = total + Cells(rowValue, c).Value
End If
Next
Next
Cells(30, 1).Value = total 'update this to suit your needs
End Sub
So we just check every cell for the "f" and if we find it, we add the value to a running total. Display the total at the end.
This will look in each worksheet, and if your text is found, add the value that's two rows below to a running total:
Sub find_Values()
Dim ws As Worksheet
Dim findStr As String
Dim foundCell As Range
Dim total As Long
findStr = "my Text"
For Each ws In ActiveWorkbook.Worksheets
Set foundCell = ws.Cells.Find(what:=findStr)
If Not foundCell Is Nothing Then
total = total + foundCell.Offset(2, 0).Value
End If
Next ws
Debug.Print "The value is: " & total
End Sub
Sub UpdateCSAH()
Dim S As String
Dim R As Long
Dim RR As Long
Dim CC As Long
Dim i As Long
Dim j As Long
Dim csah() As String 'an array that stores the CSAH sites
ReDim csah(1 To 100, 1 To 7)
Dim Ran As Range
Dim Ran1 As Range
Set Ran = Worksheets("Current Sites").Range("A1").CurrentRegion 'Ran is the region that has values
RR = 1 'row number in csah
CC = 1 'column number in csah
'check each value in Ran to see if its Route section has "CSAH"
For Each cell In Ran
R = cell.row
S = CStr(Cells(R, 4).value)
If InStr(S, "CSAH") > 0 Then 'check if "CSAH" is in the Route section
If CC > 7 Then 'reset the column number and go to the next row when reach the end of the column
CC = 1
RR = RR + 1
End If
csah(RR, CC) = cell.value
CC = CC + 1
End If
Next cell
Worksheets("CSAH Sites").Select
Range("A2:G100").Select
Selection.ClearContents
'assign each array values to cells in sheet"CSAH Sites"
i = 1
j = 1
For i = 1 To UBound(csah, 1)
For j = 1 To UBound(csah, 2)
Cells(i + 1, j) = csah(i, j)
Next j
Next i
'format the CSAH Sites values
Set Ran1 = Worksheets("CSAH Sites").Range("A1").CurrentRegion
For Each cell In Ran1
If cell.row = 1 Then
With cell.Font
.Color = -11489280
End With
ElseIf cell.row Mod 2 = 0 Then
With cell.Interior
.Color = 10092441
End With
End If
Next cell
End Sub
I have an Excel worksheet named "Current Sites" that has some data. If the 4th column has the word "CSAH", I want to store the values of that row into an array and assign those values to cells in the worksheet named "CSAH Sites". My code sometimes works (the 1st time you click), and most of times it doesn't work or doesn't work properly.
Please help me out! Thanks A Bunch!!
It looks like you want to check every row of data in the "Current Sites" sheet and if column 4 includes the "CSAH" text, then write the first 7 columns of data for that entry to the "CSAH Sites" sheet and add some colour to the even-numbered rows.
To check every row of data, you can read down just one column and use either the Offset or the Cells method to see the values of neighbouring cells. In your code you were "touching" every cell and each time you were then looking at the value in column 4 and also checking to see if the code had gone past column 7. That slows things down a lot and makes the code hard to understand.
You can also assign the values from a range of cells directly to another range of cells without using variables or an array.
See if this does what you want:
Sub UpdateCSAH()
Dim currentSitesRange As Range
Dim thisSiteRange As Range
Dim outputCell As Range
Dim numRowsOfData As Long
Const NUM_COLUMNS_OF_DATA As Integer = 7
Set currentSitesRange = Worksheets("Current Sites").Range("A1")
numRowsOfData = currentSitesRange.CurrentRegion.Rows.Count
Set currentSitesRange = currentSitesRange.Resize(RowSize:=numRowsOfData) 'currentSitesRange is the region that has values
Worksheets("CSAH Sites").Range("A2:G100").ClearContents
Set outputCell = Worksheets("CSAH Sites").Range("A2")
For Each thisSiteRange In currentSitesRange.Cells
' Look for "CSAH" in the Route section (column D)
If InStr(1, thisSiteRange.Offset(ColumnOffset:=3).Value, "CSAH", vbTextCompare) > 0 Then
' Found "CSAH" so write NUM_COLUMNS_OF_DATA columns of data to CSAH Sites sheet
outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value = thisSiteRange.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value
' Format the even-numbered rows
If outputCell.Row Mod 2 = 0 Then
With outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Interior
.Color = 10092441
End With
End If
Set outputCell = outputCell.Offset(RowOffset:=1)
End If
Next thisSiteRange
End Sub
I am new to this. I am trying to find the lowest value in a cell with multiple values inside. For example,
48
44.50
41.00
37.50
I am trying to find 37.50. What should be the code for it?
Thanks
Based on your posted example:
Sub FindMin()
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = ActiveCell.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
MsgBox wf.Min(bry)
End Sub
This assumes that there is a hard return (ASCII-10) between the fields in the cell.
EDIT#1:
To make it into a function, remove the sub and replace with:
Public Function FindMin(r As Range) As Variant
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = r.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
FindMin = wf.Min(bry)
End Function
EDIT#2:
based on your comment, here is an example of input vs output:
Note that all the values are in a single cell and the values are separated by hard returns rather than spaces.
By code with same cell and a " " as delimiter to break
temp = Range("A1").Value
temp = Split(temp, " ")
Low = CInt(temp(0))
For i = 0 To UBound(temp) - 1
If CInt(temp(i)) < Low Then Low = CInt(temp(i))
Next
Range("a2").Value = Low
if they are in a range you can use a formula
=MIN(A1:A4)
This question is pretty close to one previously asked:
VBA/EXCEL: extract numbers from one cell that contained multiple values with comma
If you take the code from that answer and replace the comma with whatever is separating your values, you will be able to get access to them in VBA. Then you can write code to find the minimum.
You can make a macro to split the values for each cell you selected and then check for the highest value. And a quick check to make sure you are not parsing all the empty rows (when you selected a column).
The macro below will set the highest value in the next column.
Sub lowest()
Dim Values As Variant
Dim LowestValue As Double
Dim a As Range
Set a = Selection
For Each Row In a.Rows
For Each Cell In Row.Cells
LowestValue = -1
Values = Split(Cell.Value, Chr(10))
For Each Value In Values
If LowestValue = -1 Then
LowestValue = Value
ElseIf Value < LowestValue Then
LowestValue = Value
End If
Next
Cells(Cell.Row, Cell.Column + 1).Value = LowestValue
If IsEmpty(Cell.Value) Then GoTo EndLoop
Next Cell
Next Row
EndLoop:
End Sub
Basically, I 'd like to combine values from two cell and then display it in another new cell after I click a button. The tricky part is every time when I enter a new value, it should display in the next row. For example, I shall combine value from A1 and B1 and pass it to C1. the next time I re-enter A1 and B1, the new value should pass to C2.
Here is the code I wrote:
Private Sub CommandButton2_Click()
Dim count As Integer
Dim rowNo As String
Dim val As String
Dim val2 As String
Dim sum As String
count = 1
rowNo = "C" + CStr(count)
If (Range("A1") <> "" And Range("B1") <> "") Then
val = Range("A1")
val2 = Range("B1")
sum = val + "/" + val2
Worksheets("Sheet1").Range(rowNo).Value = sum
count = count + 1
End If
End Sub
I am new to excel VBA, the above code only write value in A1 and it didnt go to next row when I re-enter the values, can anyone help me to solve this?
Besides answering your specific question, I will add a few (hopefully useful) comments on your code.
It is convenient to fully qualify ranges, e.g., use Worksheets("Sheet1").Range instead of Range, see this explanation.
To choose a Range you can use direct addressing (as in the comment by chris nielsen) or other options, as Offset, possibly convenient here.
It appears that your code will always go to the same target cell rowNo C1, since count is reset to 1. You will have to let your Sub know where to place the result, and this is key. I guess the safest option is to have one cell in your worksheet set to contain that information, and have your Sub reading it. If you know that column C will only contain the results you want, and that data will be contiguous there, then you could use the code below, which accounts for all items here.
It is often convenient to define a variable for using as reference, e.g., Dim rng as Range and Set rng = Worksheets("Sheet1").Range...
Code below should work.
Private Sub CommandButton2_Click()
Dim val As String
Dim val2 As String
Dim sum As String
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
With Worksheets("Sheet2")
If (IsEmpty(.Range("C1"))) Then
Set rng = .Range("C1")
Else
' There are other options to find the last cell
Set rng = .Cells(.Rows.count, "C").End(xlUp).Offset(1, 0)
End If
If (ws.Range("A1") <> "" And ws.Range("B1") <> "") Then
val = ws.Range("A1")
val2 = ws.Range("B1")
' Added ' to prevent sum being converted into a date
'sum = "'" + val + "/" + val2
sum = "'" & val & "/" & val2
rng.Value = sum
End If
End With
End Sub
PS: there are some variations in the way to select the target range, depending on the contents of your worksheet.
Try
Worksheets("Sheet1").Range(rowNo).Value = sum