Related
It's my first time doing VBA Macro and I'm having a hard time understanding the problem.
I'm trying to filter and color cells with specific values but when I try running the code it says 'Type mismatch'.
Dim count, i As Long
Dim ws As Worksheet
Dim count, i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
count = ws.Cells(Rows.count, "E").End(xlUp).Row
i = 2
Do While i <= count
If Cells(i, 5).Value = "#N/A" _
Or Cells(i, 5).Value = "#Ref" _
Or Cells(i, 5).Value = "Null" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value = "#DIV/0!" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value Like "*-*" Then
Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
i = i + 1
Loop
ws.Range("E1").AutoFilter Field:=5, Criteria1:=RGB(38, 201, 218), Operator:=xlFilterCellColor
And when I click the debug it highlights the If statements. Is there a way to solve this or is there a better way to filter these values while highlighting them in VBA?
Not really an answer, more of a expanded comment.
If IsError(Cells(i, 5)) Then
Cells(i, 5).Interior.Color = RGB(0, 0, 255)
ElseIf Cells(i, 5).Value = "" Then
Cells(i, 5).Interior.Color = RGB(0, 0, 255)
Else
Cells(i, 5).Interior.Color = xlNone
End If
Also, this to sift the errors https://learn.microsoft.com/en-us/office/vba/excel/concepts/cells-and-ranges/cell-error-values
First problem: If your cell contain an error, it doesn't contain the string "#N/A" or "#Ref", it contains a special value. What you see is only a visual representation of that error. If you want to check for an error within Excel, you should use the function IsError. That would lead to (wait, don't use that!):
If isError(Cells(i, 5).Value)
Or Cells(i, 5).Value = "Null" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value Like "*-*" Then
Second problem: In VBA, there is no optimization for a conditional statement, VBA will always evaluate all parts. Your If-statement contains several conditions, combined with Or. While other programming languages quit evaluating when one condition makes the whole expression true, VBA will continue to evaluate all conditions.
Now if you have an error in a cell and you would use the code above, you will still get a type mismatch error: You cannot compare an error with a string. The condition isError(Cells(i, 5).Value) will get True, but VBA will continue to compare the cell content with strings and that gives you the mismatch. You need a way to split your If-statement.
Some more remarks: You are assigning the worksheet you want to work with to variable ws, but you are not using it. You will need to qualify every single usage of Cells (write ws.Cells(i, 5), else VBA will assume you are working with the Active Sheet, and that may or may not be Sheet1. Usually, this is done with a With-statement (note all the leading dots).
Your declaration statement is flawed (a common mistake in VBA), you will need to specify the type for every variable. In your case, Count will be of type Variant, not Long. No problem here, but in other cases it is, so make it a habit to declare all variables correctly.
You should use a For-Loop rather than a Do While.
Dim count As Long, i As Long
With ws
count = .Cells(.Rows.count, "E").End(xlUp).Row
For i = 2 to count
Dim markCell as boolean
If isError(.Cells(i, 5).Value) Then
markCell = True
ElseIf .Cells(i, 5) = "Null" _
Or .Cells(i, 5).Value = "" _
Or .Cells(i, 5).Value Like "*-*" Then
markCell = True
Else
markCell = False
End If
If markCell Then
.Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
Next i
End With
If you want to check for specific errors you first need to check if there are errors with IsError. You cannot check for an error and a value in one condition:
Do While i <= count
Dim Condition As Boolean
Condition = False ' initialize when in a loop!
If IsError(Cells(i, 5).Value) Then
If Cells(i, 5).Value = CVErr(xlErrNA) _
Or Cells(i, 5).Value = CVErr(xlErrRef) _
Or Cells(i, 5).Value = CVErr(xlErrNull) _
Or Cells(i, 5).Value = CVErr(xlErrDiv0) Then
Condition = True
End If
ElseIf Cells(i, 5).Value = "" Or Cells(i, 5).Value Like "*-*" Then
Condition = True
End If
If Condition = True Then
Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
Loop
Filter By Color
Sub FilterByColor()
Const wsName As String = "Sheet1"
Const Col As String = "E"
Dim FilterColor As Long: FilterColor = RGB(38, 201, 218)
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
If ws.FilterMode Then ws.ShowAllData ' remove any filters
Dim lRow As Long: lRow = ws.Cells(ws.Rows.count, Col).End(xlUp).Row
Dim rgData As Range ' data range; no header
Set rgData = ws.Range(ws.Cells(2, Col), ws.Cells(lRow, Col))
rgData.Interior.Color = xlNone ' remove all colors
Dim rgColor As Range ' the combined range to be colored
Dim DataCell As Range ' each cell of the data range
Dim cString As String
Dim DoColor As Boolean
For Each DataCell In rgData.Cells
If IsError(DataCell) Then ' error value
DoColor = True
Else
cString = CStr(DataCell.Value)
If Len(cString) = 0 Then ' blank
DoColor = True
Else
If InStr(1, cString, "-") > 0 Then ' contains a minus ('-')
DoColor = True
End If
End If
End If
If DoColor Then
If rgColor Is Nothing Then ' combine cells into a range
Set rgColor = DataCell
Else
Set rgColor = Union(rgColor, DataCell)
End If
DoColor = False ' don't forget to reset
End If
Next DataCell
If rgColor Is Nothing Then Exit Sub
rgColor.Interior.Color = FilterColor ' apply color in one go
Dim rgTable As Range ' table range; header included
Set rgTable = ws.Range(ws.Cells(1, Col), ws.Cells(lRow, Col))
rgTable.AutoFilter 1, FilterColor, xlFilterCellColor
' To delete the rows, you could continue with e.g.:
' rgData.SpecialCells(xlCellTypeVisible).EntireRow.Delete
' ws.AutoFilterMode = False ' remove 'AutoFilter'
End Sub
So I have written this piece of code that manages to look for matching values for some data that is present in the lower part of the same worksheet. The data it searches from is present in the upper part of the same sheet. I have a separate column of keywords in both the upper and lower data through which the code loops through and then prints the matched row number or 'No match' if there was a match or not.
It works perfectly fine but I now want to modify it to work when the said lower part of the data is present in a completely different workbook.
Sub FindMatchingData()
For Row = 3124 To 6219
searchVal = Cells(Row, 9).Value
CheckVal = "xxx"
Srow = 3 'Row number from where the upper part data starts
While CheckVal <> searchVal And Srow < Row
CheckVal = Cells(Srow, 9).Value
Srow = Srow + 1
Wend
If CheckVal = searchVal Then
Cells(Row, 10).Value = Srow - 1
Else
Cells(Row, 10).Value = "No match"
End If
Next
End Sub
I'm unsure how to get a range of rows from that different workbook to enter into my For loop. I tried to create a variable mycell As Range and other variables are necessary and tried the below:
For Each mycell In wkb.Worksheets("Worksheetname").Range("A3:A3098")
But it doesn't seem to be working. I'm doing something wrong here. Maybe I should modify my While conditions?
Assuming, that you are searching in a different file and writing results in the file you have the macro in, I would do it like this:
Sub FindMatchingData()
Dim this_ws as Worksheet
Set this_ws = ThisWorkbook.Worksheets("sheetname")
Dim other_ws as Worksheet
Set other_ws = Workbooks("other_filename").Worksheets("other_sheetname")
For Row = 3124 To 6219
'searching in other_ws
searchVal = other_ws.Cells(Row, 9).Value
CheckVal = "xxx"
Srow = 3 'Row number from where the upper part data starts
While CheckVal <> searchVal And Srow < Row
CheckVal = other_ws.Cells(Srow, 9).Value
Srow = Srow + 1
Loop
'writing results to this ws
If CheckVal = searchVal Then
this_ws.Cells(Row, 10).Value = Srow - 1
Else
this_ws.Cells(Row, 10).Value = "No match"
End If
Next
End Sub
Cells will by default look to the active sheet, that's why I defined two different sheets at the top.
I have a workbook with multiple sheets, and new sheets will be added regularly, titled by [mmm yy] format. In my main sheet ("ContactList"), I have an IF formula with a 'nested' VLOOKUP formula in three columns to pull the respective numbers from the appropriate sheet, and I have a cell that has the date in the format I want. I want my script to look at the cell with the date in it, and use that cell's value to update the columns of VLOOKUP formulas to match that. For example, in February, the cell on my main sheet will say "Feb 20", so my VLOOKUP formulas will look in the sheet titled "Feb 20". In March, that cell will update, and I want my script (preferably automatically but tied to a button is alright) to update all the VLOOKUP functions to now be looking in the "Mar 20" sheet.
I feel like I've been trying a million things and keep getting various errors, but I'm just stuck now. My latest attempt was to set the parts of the formula as variables, then set other variables to be those parts parsed together.
Sub Update_Counts()
Dim rng As Range
Dim cellnum As Integer
Dim curr As Object
Dim v1 As String, v2 As String, v3 As String, v4 As String, v5a As String, v5b As String, v5c As String
Dim v6a As String, v6b As String, v6c As String, strFormC As String, strFormMR As String, strFormMD As String
v1 = "=IF(VLOOKUP("
v2 = Cells(cell.Row, "A")
v3 = ",'"
v4 = Cells(1, 6).Value
v5a = "'!B7:F50, 2, FALSE) = 0, 'EMPTY', VLOOKUP("
v5b = "'!B7:F50, 3, FALSE) = 0, 'EMPTY', VLOOKUP("
v5c = "'!B7:F50, 4, FALSE) = 0, 'EMPTY', VLOOKUP("
v6a = "'!B7:F50, 2, FALSE))"
v6b = "'!B7:F50, 3, FALSE))"
v6c = "'!B7:F50, 4, FALSE))"
strFormC = v1 & v2 & v3 & v4 & v5a & v2 & v3 & v4 & v6a
strFormMR = v1 & v2 & v3 & v4 & v5b & v2 & v3 & v4 & v6b
strFormMD = v1 & v2 & v3 & v4 & v5c & v2 & v3 & v4 & v6c
Set curr = Worksheets("ContactList").Cells(cellnum, 6)
Set rng = Sheets("ContactList").Range("F3:H55")
For cellnum = 3 To 55
If Cells(2, 6).Value = "Commercial Total" Then
curr.Value = strFormC
ElseIf Cells(2, 7).Value = "Medicare" Then
curr.Value = strFormMR
ElseIf Cells(2, 8).Value = "Medicaid" Then
curr.Value = strFormMD
End If
Next cellnum
End Sub
That's what I have thus far. I'm currently getting "Run-time error '424'; Object Required". I had thought having curr as an object would allow me to get through it, but I think my cellnum value is the "needs to be an object" portion of the For statement. However, I'm not sure how to get the cell values in there without how it's set up. I had tried a "For Each" loop but got a myriad of issues there as well. I wasn't able to find any examples of people wanting to update their cells' formulas by including a cell value, but perhaps I just wasn't looking in the right spot. Any advice is much appreciated!
As I put in my comment, you don't need to use VBA to achieve this.
If I'm reading your code correctly, I think you just need the following formula in cell A3 and copy it down:
=IF(VLOOKUP($A3,INDIRECT("'"&$F$1&"'!B7:F50"),IF($F$2="Commercial Total",2,IF($G$2="Medicare",3,IF($H$2="Medicaid",4,1))),FALSE)=0,"EMPTY",VLOOKUP($A3,INDIRECT("'"&$F$1&"'!B7:F50"),IF($F$2="Commercial Total",2,IF($G$2="Medicare",3,IF($H$2="Medicaid",4,1))),FALSE))
This is on the assumptions I've made from reading your code that:
Cell F1 contains the name of the sheet you want to get the data from.
One of Cells F2, G2 and H2 will contain the keywords Commercial Total, Medicare and Medicaid respectively.
If you want some code though, this is how I'd build the LOOKUP flexibly:
Sub Update_Counts()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("F3:F55")
lookupformula = "=IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F50,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F50,<colnum>,FALSE))"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 6).Value = "Commercial Total" Then
colnum = 2
ElseIf .Cells(2, 7).Value = "Medicare" Then
colnum = 3
ElseIf .Cells(2, 8).Value = "Medicaid" Then
colnum = 4
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
I figured it out from #CLR 's answer, thank you! I was struggling because I figured out the date value to stop the script from trying to import a new document, but the If/ElseIf criteria were getting a little muddied. Since the headers all always existed, it was inputting the last condition across the board, meaning I was getting column 3 data for all three columns. I am sure there's a neater way to do it, but at least for me, I'm happy with splitting the three functions and having a button run all three.
Private Sub CommandButton1_Click()
Update_Counts_COM
Update_Counts_MR
Update_Counts_MD
End Sub
Sub Update_Counts_COM()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("F3:F21,F24:F27,F30:F51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 6).Value = "Commercial Total" Then
colnum = 2
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
Sub Update_Counts_MR()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("G3:G21,G24:G27,G30:G51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 7).Value = "Medicare" Then
colnum = 3
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
Sub Update_Counts_MD()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("H3:H21,H24:H27,H30:H51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 8).Value = "Medicaid" Then
colnum = 4
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
was what ended up working for me! Thanks everyone :)
I am trying to make a loop that prints every value between two cells in a row into a single column. I would also like it to skip/ignore non integer values.
For example: Cell A5 contains 5673 and Cell B5 contains 5677. Therefore the macro would output 5673, 5674, 5675, 5676, and 5677.
I have found some useful examples for looping through each row and printing each value, but have not been able to combine the two.
To print each value between the two numbers:
[D1] = [A1].Value
ato = [B1].Value
[D1].DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=ato
To loop through every row:
LR = Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To LR
Cells(j, 1).Offset(0, 2).Value = ***Every cell value between Cells(j, 1) and Cells(j, 2)***
Next j
Before:
Desired after:
Try this. You can use SpecialCells to pick out the numerical cells, and Fill to produce the intervening sequences.
Sub x()
Dim rA As Range, rCell As Range
For Each rA In Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers).Areas
For Each rCell In rA
Range("D" & Rows.Count).End(xlUp)(2).Value = rCell.Value
Range("D" & Rows.Count).End(xlUp).DataSeries Rowcol:=xlColumns, Step:=1, Stop:=rCell.Offset(, 1), Trend:=False
Next rCell
Next rA
End Sub
If you will always have these 2 columns, then you may use this code
for j = 1 to 2:for i = 1 to cells(rows.count,j).end(xlup).row
if isnumeric(cells(i,j)) then cells(rows.count,4).end(xlup).offset(1,0) = cells(i,j)
next:next
bear in mind that it will post everysingle number, if you need to delete duplicates, you may do it using range.removeduplicate
Loop through the range cell by cell; test for IsNumeric and Duplicate values. Note: this is just a test code, you should always add workbook and worksheet references
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 2
If IsNumeric(Cells(i, j)) And Cells(i, j).Offset(, 1).Value <> Cells(i, j).Value Then
If IsEmpty(Cells(1, 4).Value) Then
Cells(1, 4) = Cells(i, j)
Else: Cells(Rows.Count, 4).End(xlUp).Offset(1) = Cells(i, j)
End If
End If
Next j
Next i
What I am doing is search some strings one by one in the entire range - like search for "blah1", if found then exit, else search "blah2" in the entire range in the same manner. "blah's" are searched in one column.
Right now i am just running a For loop code as shown below which so far works ok in my tests...but was wondering if MATCH, FIND or other methods may be faster...any opinion?
Sub test()
Dim LR As Long
LR = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
If Cells(1, "B") = "" Then
For i = 1 To LR
If Cells(i, "A") = "blah1" Then
Cells(1, "B") = Cells(i, "A").Row
Cells(1, "C") = Cells(i, "A")
Exit For
End If
Next i
End If
If Cells(1, "B") = "" Then
For i = 1 To LR
If Cells(i, "A") = "blah2" Then
Cells(1, "B") = Cells(i, "A").Row
Cells(1, "C") = Cells(i, "A")
Exit For
End If
Next i
End If
End Sub
Try this one. Since your code is repeated (for "blah1" and "blah2") I used additional function:
Sub test()
If Sheet1.Cells(1, "B") = "" Then
If findString("blah1") Then Exit Sub
If findString("blah2") Then Exit Sub
End If
End Sub
'Function findString returns TRUE if something found and FALSE otherwise
Function findString(searchString As String) As Boolean
Dim rng As Range, res
With Sheet1
Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
res = Application.Match(searchString, rng, 0)
'Application.Match returns error if nothing found
findString = Not IsError(res)
If findString Then
.Cells(1, "B").Value = rng.Cells(res, 1).Row
.Cells(1, "C").Value = searchString
End If
End With
End Function
I'm reasonably new to Excel Vba, but my limited understanding is that reading from cells is relatively slow. If I were doing this I would read all the values into an array, and carry out the same for loop as you have used, but on the array, rather than cell values.
To confirm, you could use VBAs Timer function to check speed.
Let me know if you'd like more detailed explanations of how to do this.
Here's how you can turn a range into an array (and vice versa). Step through this code with the Locals window turned on and watch what happens. You are particularly interested in the astrArray variable.
Sub ChangeArray()
'
Dim astrArray As Variant
'
' Dim astrArray
' that is, with no type specified
' is exactly equivalent
'
Dim lngIndex As Long
Dim strMessage As String
'
Range("A1").Value = "This"
Range("A2").Value = "is"
Range("A3").Value = "only"
Range("A4").Value = "a"
Range("A5").Value = "test"
astrArray = Range("A1:A5")
For lngIndex = 1 To 5
strMessage = strMessage & astrArray(lngIndex, 1) & " "
Select Case lngIndex
Case 1
astrArray(lngIndex, 1) = "No,"
Case 2
astrArray(lngIndex, 1) = "it's"
Case 3
astrArray(lngIndex, 1) = "actually"
Case 4
astrArray(lngIndex, 1) = "real"
Case 5
astrArray(lngIndex, 1) = "life"
End Select
Next lngIndex
MsgBox strMessage
Range("A1:A5") = astrArray
End Sub
A key requirement: to do this, the variable must be DIMmed Variant!
Another thing to pay attention to: the variable is two-dimensional, even though the range selected is one-dimensional.