countif in macros gives 0 results - excel

​I was trying to do a countif in a column B named First Name that has different names in it but the results is returning 0.
Here is my code:
Public Sub counting()
Dim lastcell As String
Range("B2").Select
Selection.End(xlDown).Select
lastcell = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "=countif(B2:" + lastcell + ", John)"
End Sub
If I check the formula written in the active cell it is:
=COUNTIF(B2:$B$16, John)
Please help.
I tried changing the line from
ActiveCell.Value = "=countif(B2:" + lastcell + ", John)"
to
ActiveCell.Value = "=countif(B2:" + lastcell + ", "John")" still not working.

Public Sub counting()
With Range("B2").End(xlDown)
.Offset(1, 0).Formula = "=COUNTIF(B2:" & .Address(False, False) & ", ""John"")"
End with
End Sub

Try,
ActiveCell.formula = "=countif(B2:" & lastcell & chr(44) & chr(34) &"John" &chr(34) & ")"

Related

VBA Excel InStr(myString) returns no result

I want to multiply my range of cells by -1 when they matches the Instr criteria.
but I still get positive values, which are based on my else statement.
Basically, I use the ConverdDecimal function from this link:
https://www.extendoffice.com/documents/excel/1497-excel-convert-decimal-degrees-to-degrees-minutes-seconds.html
with doesn't cope well with negative values. Hence I have to modify my code.
Sub Sun()
Dim rng As Range, cell As Range, rngB As Range, rngC As Range
Dim wors As Worksheet
Dim myString As String
Set wors = ThisWorkbook.ActiveSheet
Dim lastRow As Long, LastRow2 As Long
wors.Columns("E").Copy
wors.Columns("P").PasteSpecial xlPasteValues
wors.Columns("F").Copy
wors.Columns("R").PasteSpecial xlPasteValues
lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
LastRow2 = wors.Range("Q" & wors.Rows.Count).End(xlUp).Row
Set rng = wors.Range("P1:P" & lastRow)
Set rngB = wors.Range("R1:R" & lastRow)
Set rngC = wors.Range("F1:F" & lastRow)
For Each cell In rng
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
Next
For Each cell In rngB
cell = WorksheetFunction.Substitute(cell, "-", "")
cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
Next
With words
Range("Q2:Q" & lastRow).Formula = "=ConvertDecimal(P2)"
Columns("Q").Copy
Columns("X").PasteSpecial xlPasteValues
Range("S2:S" & lastRow).Formula = "=ConvertDecimal(R2)"
End With
With rngC
If InStr(myString, "-") <> 0 Then
Range("T2:T" & lastRow).Formula = "=S2 * -1 "
Else
Range("T2:T" & lastRow).Formula = "=S2"
End If
End With
End Sub
I tried:
Range("T2:T" & lastRow).Formula = "=S2 * (-1) "
Range("T2:T" & lastRow).Formula = "=-S2"
Range("T2:T" & lastRow).Formula = "=-1 * S2"
Nothing works
What is wrong with my code? Why does it cove only the Else situation? I need negative formulas wherever the "-" appears in column F.
Is there any reason why this would not work: For cell T2 use the formula
=IF(LEFT(TRIM(F2), 1)="-", -1, 1)*S2
or if you want to do it in VBA
Range("T2:T" & lastRow).FormulaR1C1="=IF(LEFT(TRIM(RC6), 1)=""-"", -1, 1)*RC[-1]"
is it failing because of this typo and you do not have option explicit?
With words
words is not defined but wors is so if no option explcit a variable words is created at runtime but is set to nothing so nothing happens inside the with block

How to make a variable array based on information inside of cells?

I am trying to make a list of sheets to hide or unhide based on whether a checkbox is clicked. I want to have a list of the sheets over a range of cells, but my function isn't working. I assume it's because it is considered a string and I am calling it as something.
With Worksheets("Home Page").Cells
Set findSheets = .Find(What:="Sheets", LookIn:=xlValues)
End With
findSheets.Select
Selection.Offset(2, 0).Select
num = 1
ArrayList = Chr(34) & Selection.Value & Chr(34)
Selection.Offset(1, 0).Select
For Each MyCell In Range(Selection, Selection.End(xlDown))
ArrayList = ArrayList & ", " & Chr(34) & Selection.Value & Chr(34)
Selection.Offset(1, 0).Select
Next
ArrayList = ArrayList & ")"
ArrayList = Array(ArrayList)
If CheckBox1.Value = True Then
Worksheets(Array(ArrayList)).Visible = True
Else
Worksheets(Array(ArrayList)).Visible = False
End If
Dim shet
For Each shet In arraylist
Worksheets(shet).Visible = CheckBox1.Value
Next shet

How to select row before and after row with specific text in Excel?

My raw data looks something like this;
std1
std1
deviant
std2
std1
std2
std2
deviant
The "deviants" are presented randomly and thus do not occur every nth row...
I wish to select 1 row before and 1 row after each "deviant" row so I can copy it in another spread sheet.
See code below.
We loop through each row in the column (I have assumed your data is in column A) and when the given value is found, we add the following and prior rows to our selection array. When the loop is complete, we select the rows in the array
Public Sub DeviantSelect()
Dim myRange As Range
Set myRange = Nothing
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 1) = "deviant" Then
If myRange Is Nothing Then
Set myRange = Union(Range(i - 1 & ":" & i - 1), Range(i + 1 & ":" & i + 1))
Else
Set myRange = Union(myRange, Range(i - 1 & ":" & i - 1), Range(i + 1 & ":" & i + 1))
End If
myRange.Select
End If
Next
End Sub
The below code copies the cells before and after deviant to another sheet.
Sub check()
Sheet1.Activate
Range("A1").Select
LastRow = Sheets("Sheet1").UsedRange.Rows(Sheets("Sheet1").UsedRange.Rows.Count).Row
For i = 1 To LastRow
Sheet1.Activate
If Range("A" & i).Value = "deviant" Then
Range("A" & i - 1).Select
Selection.Copy
Sheet2.Activate
LastRow2 = Sheets("Sheet2").UsedRange.Rows(Sheets("Sheet2").UsedRange.Rows.Count).Row
If LastRow2 = 1 Then
Range("A" & LastRow2).Activate
Else
Range("A" & LastRow2 + 1).Activate
End If
ActiveSheet.Paste
Sheet1.Activate
Range("A" & i + 1).Select
Selection.Copy
Sheet2.Activate
LastRow2 = Sheets("Sheet2").UsedRange.Rows(Sheets("Sheet2").UsedRange.Rows.Count).Row
Range("A" & LastRow2 + 1).Activate
ActiveSheet.Paste
End If
Next
End Sub

Excel list VBA concatenate

Image below shows an Excel list I have. Columns A-C is the contents I have. Columns D and E is the result I'm looking for. I've manually entered it to show the result.
Currently my code looks like this:
Option Explicit
Sub New_SKU()
Dim wb As Workbook
Dim ws As Worksheet
'figure out how far down data goes
Dim endrow As Long
Dim currentrow As Long
Dim basename
Set wb = ThisWorkbook
Set ws = wb.Sheets("Blad1")
With ws
endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'always start in the correct column
.Cells(.Cells(1, "B").End(xlDown).Row, "B").Activate
'loop through all data
Do While ActiveCell.Row < endrow
'loop through empty cells and set formula if cell isn't empty
Do While ActiveCell.Row <= endrow
'if next cell isn't empty, isn't past the end of the list, go to outer loop
If ActiveCell.Formula <> "" And ActiveCell.Offset(1, 0).Formula = "" And ActiveCell.Row <= endrow Then
basename = Selection.Address
ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
Else
Exit Do
End If
' End If
' End If
' End If
' End If
' End If
Loop
Loop
End With
End Sub
I am reusing code from a similar problem I received help with earlier.
My first problem:
If uncomment the If-statements, when I start the script Excel goes blank (white) and stalls immediatly.
Running the script in its current state (If-satements commented out), I can see that I get the correct result in cell D2 and then cell B3 is selected (keep in mind that there are no results in column D or E), and then the screen goes blank and Excel stalls. I do not get any result in column E.
Since there are variation in sizes (column C), it can vary from 2-3 to 5-6.
I cannot figure out why I won't receive a result in E-column and why it stalls and goes white.
Any ideas?
As per comment above, here is a different approach
Sub x()
Dim r As Long
Columns(2).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(r, 4).Value = Cells(r, 2).Value & "-" & Cells(r, 3).Value
Cells(r, 5).Value = Cells(r, 2).Value
Next r
Columns(2).SpecialCells(xlCellTypeFormulas).ClearContents
End Sub
If you're okay with a non-VBA answer, you can paste this formula in D2 and copy down:
=IF(B2="",LEFT(D1,FIND("-",D1)-1)&"-"&C2,B2&"-"&C2)

Using a negative loop number in VBA

I have a for loop, using i as the counter, in Excel VBA. I have one statement that stubbornly gives me errors:
ActiveCell.FormulaR1C1 = "=VLookup(RC[-3],R3C7:R22C15,3)" & " & " & "R[-i]C" & " _
& " & "Vlookup(RC[-3],R3C7:R22C15,4)"
Using the -i is evidently causing the errors. I tried adding
negi=-i and then changing the R[-i]C to R[negi]C, but that didn't fix it. I added a Dim negi as Integer statement in earlier code.
Edit: Here's more of the code. I'm using two loops. rownumber is the counter for the outer loop, and i is the counter for the inner loop. i ranges from 1 to 20, and rownumber ranges until a row is reached with a blank in column 3.
Range("A25").Select
Dim Rownumber As Integer
Dim i As Integer
Dim negi As Integer
Rownumber = 1
' This starts the outer loop
Do While ActiveCell.Offset(0, 3) <> ""
' Adds twenty rows
ActiveCell.Offset(1, 0).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(19, 5)).Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Select
For i = 1 To 20
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = i
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Rownumber
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Vlookup(RC[-2],R3C7:R22C15,2)"
ActiveCell.Offset(0, 1).Select
negi = -i
ActiveCell.FormulaR1C1 = "=VLookup(RC[-3],R3C7:R22C15,3)" & " & " & _
"R[negi]C" & " & "& "Vlookup(RC[-3],R3C7:R22C15,4)"
....
rownumber = rownumber + 1
next i
How can I accomplish this while avoiding errors?
There are a couple of bad string concatenations in the formula build.
i will have to be outside of the quoted string(s) and concatenated in and & " & " & probably isn;t doing what you want it to.
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],R3C7:R22C15,3)&" & _
""" & ""&R[-" & i & "]C&"" & ""&" & _
"VLOOKUP(RC[-3],R3C7:R22C15,4)"
Remember that you have to double up quotes within a quoted string.
You can do a loop from a greater value to a lower value. This will loop from the last cell used to the first.
lRow = ws.UsedRange.Rows.count
Do While lRow > 0
lCol = ws.UsedRange.Columns.count
Do While lCol > 0
If InStr(ws.Cells(lRow, lCol), job) Then
End If
lCol = lCol - 1
Loop
lRow = lRow - 1
ws.Range("A" & lRow).Activate
Loop

Resources