I am trying to run a code to validate a column "K". If any cells in column "K" is Null then an error message should pop up and the cell should turn to red. I tried the following code and it is working. Following is my issue.
I run the macro.
Macro detects the Null cell and pop up error msg.
I deleted the row with Null cell.
Run macro again.
Error msg pop up again. Last cell of column K turn into red eventhough that row doesnt have any data.
This is the code I am using
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2
If Range("K" & n).Value = vbNullString Then
Range("K" & n).Interior.ColorIndex = 3
MsgBox "Error ! Null value "
Exit Sub
End If
Next n
End Sub
Use another column (like an ID or something that is never going to blank) and use that in the IF statement too
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2
If Range("K" & n).Value = vbNullString AND Range("A" & n).Value <> "" Then
Range("K" & n).Interior.ColorIndex = 3
MsgBox "Error ! Null value "
Exit Sub
End If
Next n
End Sub
Actually, your code is also work the last row. Just remove last row from loop. It will OK.
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2 - 1 'Just modify it
If Range("C" & n).Value = vbNullString Then
Range("C" & n).Interior.ColorIndex = 3
MsgBox ("Error ! Null value ")
Exit Sub
End If
Next n
End Sub
Related
I'm trying to copy some data from one Sheet to another using a vba script, it works fine but it doesn't appear to gather all the results, the data i have is split up over multiple tables so i assume it's seeing a blank space and stepping out but i'm not sure the solution! (the results i'm after are all letters i.e A-f and are all located on column C)
code below:
Sub copytoprint()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Application.ScreenUpdating = False
On Error GoTo Err_Execute
LSearchRow = 2
LCopyToRow = 2
While Len(Range("C" & CStr(LSearchRow)).value) > 0
If InStr(1, Range("C" & CStr(LSearchRow)).value, "A") > 0 Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Sheets("dest").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
LCopyToRow = LCopyToRow + 1
Sheets("source").Select
End If
LSearchRow = LSearchRow + 1
Wend
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Input would just be a basic line of details i.e
ID person ref itemid itemname shape
Alphas1 bob A As01 Alphaselects1 circle
Alphas2 Stuart B As02 Alphaselects2 circle
Basically they are split up with many records I'd like it to grab all the A reference put them in one table then folow on with B C etc
Hope that makes a little sense?
Looks like you want to search from ActiveSheet using certain reference (A,B,C,,etc) and copy matching rows into unique destination sheets.
Below code will help you accomplish this, it separates the copying sub-procedure out into its own sub (called copyToSheet) and you can keep calling it from copytoprint() each time giving a reference and the destination sheet you desire.
Option Explicit
Private Sub copyToSheet(reference As String, shtSource As Worksheet, shtDest As Worksheet)
Dim x As Integer
Dim y As Integer
shtDest.Range("A2:Z" & shtDest.UsedRange.Rows.Count + 2).ClearContents
x = 2
y = 2
'loop until 20 consequtive rows have column C blank
While (Not shtSource.Range("C" & x).Value = "") _
And (Not shtSource.Range("C" & (x + 1)).Value = "") _
And (Not shtSource.Range("C" & (x + 5)).Value = "") _
And (Not shtSource.Range("C" & (x + 10)).Value = "") _
And (Not shtSource.Range("C" & (x + 20)).Value = "")
'If shtSource.Range("C" & x).Value, reference) > 0 Then
If shtSource.Range("C" & x).Value = reference Then
shtDest.Range("A" & y & ":Z" & y).Value = shtSource.Range("A" & x & ":Z" & x).Value
y = y + 1
End If
x = x + 1
Wend
End Sub
Public Sub copytoprint()
copyToSheet "A", ActiveSheet, Sheets("A")
copyToSheet "B", ActiveSheet, Sheets("B")
MsgBox "All matching data has been copied."
End Sub
So if I understood your problem correctly then you want to sort the data in sheet source first and then paste all of that data in another sheet.
If that's the case try this code.
Sub copytoprint()
Dim lastrow As Double
With Sheets("source")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A2:F" & lastrow).Sort key1:=Range("C3:C" & lastrow), order1:=xlAscending, Header:=xlNo
End With
Sheets("dest").Range("A2:F" & lastrow).Value = Sheets("source").Range("A2:F" & lastrow).Value
End Sub
I have value in Sheet1 "B" column which is to be vlookup in Sheet2 from Column "A to K" and copy the corresponding C column value of Sheet2 and paste it in Sheet1's E column.
I have tried with below code but it shows error as
Run-time error '1004':
Unable to get the Vlookup Property of the worksheetfunction class.
Sub vlook_up()
For i = 2 To 11
Cells("D" & i).Value = WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, 0)
Next i
End Sub
This works for me, however I feel you are passing the function an inappropriate var type.
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False), "error")
Next i
End Sub
Try with this
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False);
Next i
End Sub
or
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = Application.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False);
Next i
End Sub
I'm trying to do a beforesave event, not allowing users to save if one of two given cells are empty. What I managed to do so far is linking column 13 (M) and cell A4.
What I'd like to do is applying the event to a combination of two range and rows, A4-A19 and M4-M19. In this way: If A4 is not empty and M4 is empty, a msgbox appears and blocks saving and so on..A5-M5, A6-M6...until A19-M19. If both corresponding cells are empty at the same time, then saving should be possible.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Integer, MyWb As Object
i = 13
Set MyWb = ThisWorkbook.Sheets("Planning").Cells
Do While MyWb(4, i).Value <> ""
i = i + 1
Loop
If i = 13 Then
If ThisWorkbook.Sheets("Planning").Range("A4") <> "" Then
MsgBox ("You will need to enter topics before saving"), vbCritical
Cancel = True
End If
End If
End Sub
Based on Wolfie's code, I managed to obtain what I wanted, just adding a If not isempty for A column and replacing 19 instead of 13.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim plansht As Worksheet
Set plansht = ThisWorkbook.Sheets("Planning")
' Loop over rows
Dim rw As Integer
For rw = 4 To 19
' Test if both the A and M column in row "rw" are blank
If Not IsEmpty(plansht.Range("A" & rw)) And plansht.Range("M" & rw).Value = "" Then
MsgBox ("You will need to enter topics before saving"), vbCritical
Cancel = True
End If
Next rw
End Sub
Try this :
For i = 4 to 19
If ThisWorkbook.Sheets("Planning").Range("A" & i) <> "" AND _
ThisWorkbook.Sheets("Planning").Range("M" & i) <> "" Then
MsgBox("Hey bro you didn't wrote properly on line " & i)
Cancel = True
Next i
You can loop over the rows, and just test the A and M columns to test if they are both blank for a given row. See the below code...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim plansht as Worksheet
Set plansht = ThisWorkbook.Sheets("Planning")
' Loop over rows
Dim rw as Integer
For rw = 4 to 13
' Test if both the A and M column in row "rw" are blank
If plansht.Range("A" & rw).Value = "" And plansht.Range("M" & rw).Value = "" Then
MsgBox ("You will need to enter topics before saving"), vbCritical
Cancel = True
End If
Next rw
End Sub
Edit:
Your edit suggested you want some different combinations of the cells being empty. Here are some examples of the If statement for different outcomes
' If BOTH are empty
If plansht.Range("A" & rw).Value = "" And plansht.Range("M" & rw).Value = "" Then ...
If IsEmpty(plansht.Range("A" & rw)) And IsEmpty(plansht.Range("M" & rw)) Then ...
' If EITHER is empty
If plansht.Range("A" & rw).Value = "" OR plansht.Range("M" & rw).Value = "" Then ...
If IsEmpty(plansht.Range("A" & rw)) Or IsEmpty(plansht.Range("M" & rw)) Then ...
' If BOTH are NOT empty
If plansht.Range("A" & rw).Value <> "" And plansht.Range("M" & rw).Value <> "" Then ...
If Not IsEmpty(plansht.Range("A" & rw)) And Not IsEmpty(plansht.Range("M" & rw)) Then ...
Notice that when you start introducing Not with multiple conditions, the logic can quickly become hard to interpret. You can use brackets to group conditions with a Not, but you get things like this meaning the same logically:
If Not IsEmpty(plansht.Range("A" & rw)) And Not IsEmpty(plansht.Range("M" & rw)) Then ...
If Not (IsEmpty(plansht.Range("A" & rw)) Or IsEmpty(plansht.Range("M" & rw))) Then ...
Give this a try:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const FIRST_ROW as integer = 4
Const LAST_ROW as integer = 19
Const ColA As Integer = 4
Const ColM as integer = 13
Dim MyWb As Worksheet
Dim CurRow as Integer
Set MyWb = ThisWorkbook.Sheets("Planning")
For CurRow = FIRST_ROW to LAST_ROW
If len(mywb.cells(CurRow, ColA)) = 0 and len(mywb.cells(CurRow, ColM)) = 0 then
MsgBox ("You will need to enter topics before saving"), vbCritical
Cancel = True
Exit For
End If
Next
End Sub
Untested code (I can never remember if it's (Row,Col) or (Col,Row)), but I think that will get you what you're after. This will abort the save on the first pair where they're both blank.
If this works, you could get fancy and highlight the blank pair(s), remove the highlight for OK pairs (in case they were highlighted previously), processing through all the pairs and removing the Exit For and providing one error message that anything highlighted needs to be looked after.
I've been told that Len(string) = 0 is a faster way to determine that a string is null than string = vbNullString. No guarantees as to suitability to purpose, but that's what I've learned.
I have an excel sheet, with column both A、B、C、D.
Both C & D number changes all the time (they have different criteria), since it calculates by stock data that fetches in real-time.
I need message box to pop up both when C & D matches my target value, and showing the the ticker in column A, the name in column B, and the number in C/D.
With the help I know the code when there is only column C:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.column = 3 And Target.value >= -4 And Target.value <= 4 Then
Call MsgBoxMacro(Target.value, Target.column, Target.row)
End If
End Sub
Sub MsgBoxMacro(value, column, row)
MsgBox "Ticker: " & Cells(row, column - 2) & vbNewLine & "Stock Name: " & Cells(row, column - 1) & vbNewLine & "Variable Value: " & value
End Sub
I don't know what to do, when I want to add column D data into the code. (so i can have message box pop up when D number reaches the criteria) please help.
Thank you!
By passing another parameter to the function MsgBoxMacro will solve your problem:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.column = 32 And Target.value >= -4 And Target.value <= 4 Then
Call MsgBoxMacro(Target.value, Target.column, Target.row, 0)
End If
If Target.column = 33 And Target.value >= -4 And Target.value <= 4 Then
Call MsgBoxMacro(Target.value, Target.column, Target.row, 1)
End If
End Sub
Sub MsgBoxMacro(value, column, row, counter)
MsgBox "Ticker: " & Cells(row, column - 31 - counter) & vbNewLine & "Stock Name: " & Cells(row, column - 30 - counter) & vbNewLine & "Variable Value: " & value
End Sub
Hope this helps.
Something like this, not far from what you had. This will go in the worksheet where the changes are to be made.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
If ((Target.Offset(0, -1).Value > -4 And Target.Offset(0, -1).Value < 4) And _
(Target.Value > -4 And Target.Value < 4)) Then
' Msgbox here
Else
End If
End If
End Sub
Could use some help on a project. My table looks something like this:
WEEK1 TEST1 VALUE
WEEK1 TEST1 [blank]
WEEK1 TEST2 [blank]
WEEK2 TEST1 VALUE
WEEK2 TEST2 [blank]
WEEK2 TEST1 VALUE
About 800 rows of these in different variations.
Now I need to find the first empty cell in C that has WEEK2 and TEST2 next to it. How would one go about doing this? Purpose is to enter a value in that cell that comes from a userform that defines A and B.
Sub FindMatch()
Dim sTxt1 As String, sTxt2 As String, vMatch As Variant
sTxt1 = """Week2"""
sTxt2 = """Test2"""
sformula = "MATCH(1,(A:A=" & sTxt1 & ")*(B:B=" & sTxt2 & "),0)"
vMatch = Evaluate(sformula)
If IsNumeric(vMatch) Then MsgBox Range("C" & vMatch).Address
End Sub
Added another condition to check whether Column-C is blank? Replace the below line of code to verify the column-C part also.
sformula = "MATCH(1,(A:A=" & sTxt1 & ")*(B:B=" & sTxt2 & ")*(C:C=""""),0)"
Try this code.
Sub CheckRows()
Dim RowNo As Long
RowNo = 1
With ActiveWorkbook.Sheets(1)
Do While .Cells(RowNo, 1).Value <> ""
If UCase(.Cells(RowNo, 1).Value) = "WEEK2" And _
UCase(.Cells(RowNo, 2).Value) = "TEST2" And _
.Cells(RowNo, 3).Value = "" Then
MsgBox "Found at Row Number " & RowNo
Exit Sub
Else
RowNo = RowNo + 1
End If
Loop
End With
End Sub
Sub test()
Dim x As Range, i&: i = [C:C].Find("*", , , , , xlPrevious).Row
For Each x In Range("A1:A" & i)
If UCase(x.Value2 & x.Offset(, 1).Value2 & _
x.Offset(, 2).Value2) = "WEEK2TEST2" Then
MsgBox x.Offset(, 2).Address(0, 0): Exit For
End If
Next x
End Sub