Count if cell not blank - vba

Hi All I have 2 formulas i'm trying to run but struggling to get the COUNTIF to calculate only if the cell isn't blank.
Sheets("Home").Select
If Range("A2:A14").Count = "13" Then
MsgBox "Current Load Full Please Complete & Export", vbCritical
Exit Sub
End If
2nd Code
Sheets("Home").Select
If Range("A2:A14").Count < "13" Then
MsgBox "Shipment is short do you want to continue?", vbCritical vbYesNo
Exit Sub
End If
On the 2nd code if vbYes then run code if vbNo then exit sub.

If you're trying to do some action depending on the condition "all cells in range A2:A14 are filled or not" - then this code might be the answer.
Sub check_count()
Sheets("Home").Select
Dim myRange As Range
Set myRange = Worksheets("Home").Range("A2:A14")
'using excel's built in function CountA to check count of non-blank cells
'if the count is 13 - then msgbox
If Application.WorksheetFunction.CountA(myRange) = 13 Then
MsgBox "Current Load Full Please Complete & Export", vbCritical
Exit Sub
'if the count is less then 13 - then do following
Else:
msg1 = MsgBox("Shipment is short do you want to continue?", vbYesNo)
If msg1 = vbYes Then
MsgBox "Enter missing products in A2:A14" 'you can run some code here as well
Else: Exit Sub
End If
End If
End Sub
Hope this answers your question.

In order to count all non-blank cells in a given range, you could use:
If ActiveSheet.Range("A2:A14").SpecialCells(xlCellTypeConstants).Count < 13 Then

Related

How to vlookup another excel sheet in VBA

Sub lookuphcpcs()
On Error GoTo errorbox:
Dim hcpcs_code As Long
Dim desc As Variant
hcpcs_code = ActiveCell.Value
If Len(hcpcs_code) > 0 Then
desc = Application.WorksheetFunction.VLookup(Active_cell, 'C:\Users\Username\Desktop\[Fruit Code.xlsx]Sheet1'!$A$2:$B$7, 2, False)
MsgBox "Description for HCPCS Code " & hcpcs_code & " is """ & desc & """"
Else
MsgBox "You did not enter any input!"
End If
Exit Sub
errorbox:
If Err.Number = 1004 Then
MsgBox "No Description found under HCPCS list!"
End If
End Sub
I am not able to put table array value under Vlookup in VBA to point to another excel sheet.
How do I do that?
First, when working with Vlookup you need to handle errors, such as when Vlookup was unable to find a match, you can use If Not IsError(Application.VLookup(.... to achieve this.
Second, in your case you don't need to use On Error GoTo errorbox:, just use the Vlookup error handling I wrote in the first point.
Third, you can use If Trim(ActiveCell.Value2) <> "" Then to verify there is a valid text or number inside ActiveCell rather than empty spaces.
Fourth, you should avoid using ActiveCell, and use fully qualified object instead.
Last, you want to make sure "Fruit Code.xlsx" workbook is open before using the Vlookup, as suggested by #Tim Williams in the comments above.
Modified Code
Option Explicit
Sub lookuphcpcs()
Dim desc As Variant
Dim SourceWb As Workbook
' error trapping in case Fruit Code workbook is closed
On Error Resume Next
Set SourceWb = Workbooks("Fruit Code.xlsx")
On Error GoTo 0
If SourceWb Is Nothing Then
Set SourceWb = Workbooks.Open("C:\Users\Username\Desktop\Fruit Code.xlsx") ' open workbook if it's closed
End If
If Trim(ActiveCell.Value2) <> "" Then ' make sure cell has a string other than space
If Not IsError(Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)) Then
desc = Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)
MsgBox "Description for HCPCS Code " & ActiveCell.Value2 & " is """ & desc & """"
Else
MsgBox "No Description found under HCPCS list!"
Exit Sub
End If
Else
MsgBox "You did not enter any input!"
End If
End Sub

VBA Message box to work through a filtered selection of data

I'm trying to create a macro that I can run on a worksheet that uses autofilters. In an ideal world my macro should display a message box that gives me three options:
1) Run a specific set of VBA instructions (in the code below it is to colour cell B2) on the first visible row (ignoring the header) then move to the next visible row and display the message box again.
2) Skip this row, find the next visible row and display the message box again.
3) Quit the macro.
I have the bare bones of the macro below however I feel I'm missing some clever way of displaying the message box again after the first two buttons are pressed. Also I'm not convinced by my code to end the macro.
FYI: The reason for the message box rather than a flat out looped macro is that the filters regularly change and I'm looking to reduce the need to rewrite the code based on the necessary filters.
Sub Msg_exe()
Dim Option_Menu As Integer
Dim strMsg As String
Dim strTitle As String
Range("B2").Select
strMsg = "Continue with this row"
strTitle = "Alert"
Option_Menu = MsgBox(strMsg, vbYesNoCancel + vbQuestion, strTitle)
Select Case Option_Menu
Case 6 'code to colour the cell goes here
Selection.Font.ColorIndex = 25
Selection.Interior.ColorIndex = 33
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(1, 0).Activate
Loop
'I need some code to show the message box again ready for the next row
Case 7 'code to skip to the next visable line goes here
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(1, 0).Activate
Loop
'I need some code to show the message box again ready for the next row
Case 2 'the code to end the macro goes here (I hope this is correct)
End
End Select
End Sub
You could loop through the rows, beginning at whichever row you decide, and ascertain if the calculation is required thereafter (I haven't tested so please check this matches your requirements first):
Sub Msg_exe()
Dim cur_row as long
Dim Option_Menu As Integer
Dim strMsg As String
Dim strTitle As String
For cur_row = 2 to Range("A65000").End(xlUp).Row 'Modify this row referenced to suit
if not Range("B" & cur_row).EntireRow.Hidden then
Range("B" & cur_row).Select
strMsg = "Continue with this row"
strTitle = "Alert"
Option_Menu = MsgBox(strMsg, vbYesNoCancel + vbQuestion, strTitle)
Select Case Option_Menu
Case 6 'code to colour the cell goes here
Selection.Font.ColorIndex = 25
Selection.Interior.ColorIndex = 33
Case 7 'code to skip to the next visible line goes here
Case 2 'the code to end the macro goes here (I hope this is correct)
Exit Sub
End Select
End If
Next
End Sub

Multiple If Statements VBA

I'm very new to VBA and SQL, and I'm currently building a table to be uploaded to SQL onto Excel and using VBA.
I want to essentially say if column I(Check Market) or J(Check m2) have a value that says #NA then go no further and don't carry out the upload or the rest of the code. I think one of the problems might be I already have an IF loop - which is successful and has no errors associated with it.
This is my code so far
'Where Marked sht.Cells(Row,15) = "x" 'FIRST IF LOOP
If sht.Cells(lRow, 15) = "X" Then
'If I or J columns say #N/A then DO NOT continue
If IsError(sht.Cells(lRow, 9).Value) Then MsgBox "Error in Column 'Check Market'"
If IsError(sht.Cells(lRow, 10).Value) Then MsgBox "Error in Column 'Check m2'"
''''At the moment it is the above part that isn't successfully running, it notifies the user of an error but doesn't stop the process.
'Change blank spaces to be Null
*******
sSQL = *******Main part of code goes here******
'execute queries
********
'Put back all the 'null' values to blank
'''''
End If 'END OF IF X LOOP
I'm not clear if there's a possibility that both columns might have an error but I've provided for that just in case.
'If I or J say #N/A then dont proceed with upload.
If iserror(sht.Cells(lRow, 9).value) and iserror(sht.Cells(lRow, 10).value) Then
MsgBox "Errors in both Columns"
ElseIf iserror(sht.Cells(lRow, 9).value) Then
MsgBox "Error in Column 'Check Market'"
ElseIf iserror(sht.Cells(lRow, 10).value) Then
MsgBox "Error in Column 'Check KPI'"
Else: 'Continue
End if
Just adding to your original Code
I(9):Check Market J(10):Check m2
'If I or J say #N/A then dont proceed with upload.
If sht.Cells(lRow, 9).Value = "#N/A" Then
MsgBox "Error in Column 'Check Market'"
Exit Sub
ElseIf sht.Cells(lRow, 10).Value = "#N/A" Then
MsgBox "Error in Column 'Check KPI'"
Exit Sub
Else: 'Continue
Code for exiting with MsgBox
Dim response
response = MsgBox("My message here.", vbYesNo, "My Title")
If response = vbNo Then
Exit Sub
End If
MsgBox ("You clicked YES.")

Checking name of last worksheet

I'm trying to check the name of the last worksheet and see if it equals "Field_10" . If it does, I don't want it to do anything but if it doesn't, I want to add new worksheets.
Expected output when there is only one sheet titled "Sheet1":
Outputs "Adding new sheets" and adds ten new sheets titled Field_1 all the way up to Field_10.
Expected output when the sheets (Field_1,..., Field_10) have already been added:
Outputs "New sheets already added" and exits if statement.
I've included MsgBoxes to help with debugging. The problem is, whether or not I check if the last sheet name is EQUAL to "Field_10" or NOT EQUAL to "Field_10", it always outputs "New sheets already added".
If ThisWorkbook.Worksheets(Worksheet.Count).Name = "Field_10" Then
'If ThisWorkbook.Worksheets(Worksheet.Count).Name <> "Field_10" Then
MsgBox ("New sheets already added")
Else
MsgBox ("Adding new sheets")
On Error Resume Next
For h = 1 To 10
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Field_" & CStr(h)
Next h
End If
Any help would be appreciated.
Use below sub:
Sub AddSheets()
Dim NewSheetNo As Integer
If ThisWorkbook.Worksheets(Worksheets.Count).Name = "Field_10" Then
MsgBox ("New sheets already added")
Else
MsgBox ("New sheets are being aded...")
On Error Resume Next
For NewSheetNo = 1 To 10
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Field_" & NewSheetNo
Next
End If
End Sub

Range & If Statement using multiple sheets

I have several Sheets involved but I'll have Sheet 2 Active. When I'm on "Sheet 2" I need to know when cell ("C14") becomes active with an IF statement I'm guessing. Once it becomes active, I then need to know if the string in cell ("B2") on Sheet 1 = "Fighter" then I want to insert "some wording regarding the fighter here" in cell ("C14") on Sheet 2. IF it's not "Fighter"then is it "Mage"? If so then insert "some wording regarding the mage here".
This is short hand for example.
if cell C14 on Sheet 2 is active then
check cell B2 on Sheet1. If the text = "Fighter"? Then
insert "You are brave and use a sword" into cell C14 Sheet2
if it's not equal to Fighter then is it = "Mage"? Then
insert "You cast spells" in cell C14 sheet2
etc..
I need to know how to code this in VBA. I've spent hours searching and trying various code but can't seem to get it right. Thanks ahead of time for your help.
Try something like this:
'The way you check which cell is active is by using an
'Event like this one. This goes into the Sheet2 code module
'which you can get to by right clicking on the sheet's tab and
'selecting View Code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng_Source As Excel.Range
Dim rng_Target As Excel.Range
On Error GoTo ErrorHandler
'Setting the cells that you're interested in as
'ranges will help minimise typo errors.
Set rng_Target = ThisWorkbook.Sheets("Sheet2").Range("C14")
Set rng_Source = ThisWorkbook.Sheets("Sheet1").Range("B2")
'Target is a range that specifies the new
'selection. Check its address against rng_Target
'which we defined above.
If Target.Address <> rng_Target.Address Then
Exit Sub
End If
'If you don't want case sensitivity, convert to upper case.
If UCase(rng_Source.Value) = "FIGHTER" Then
rng_Target.Value = "some wording regarding the fighter here"
ElseIf UCase(rng_Source.Value) = "MAGE" Then
rng_Target.Value = "You cast spells"
'You get the idea.
End If
ExitPoint:
On Error Resume Next
'Clean up
Set rng_Source = Nothing
Set rng_Target = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbCrLf _
& Err.Description
Resume ExitPoint
End Sub
I do agree with the comments that you should always post the code that you've already tried (which you subsequently did), but this is a relatively trivial one and this just clears it out of the way and may be of use to somebody else as well in the future.
Try this ;)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errH
Dim rng1 As Range
Set rng1 = ThisWorkbook.Worksheets(1).Range("B2")
If Not Intersect(Target, Me.Range("C14")) Is Nothing Then
Application.EnableEvents = False
If rng1.Value2 = "Mage" Then
Target.Value = "OMG This is MAGE!!! Run run run away!!!"
ElseIf rng1.Value2 = "Fighter" Then
Target.Value = "Fighter? :/ Was hoping for something better"
MsgBox "Fighter? :/ Was hoping for something better"
rng1.Value2 = "Mage"
Target.Value = "Mage. Now This is better ;)"
Else
Target.Value = "No, we haven't discussed it."
End If
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & "Description: " & Err.Description)
Application.EnableEvents = True
End Sub