I want to check the my worksheet for text in mandatory fields before I save my file. If cells B50:B53 has a text, corresponding cells D50:D53 are mandatory. If cells B50:B53 are empty, corresponding fields in column D are optional.
If I apply this rule to one row it works with the following code. However, I want to test all cases (B50 and D50, B51 and D51...). How can I do this without copying the code 4 times?
Dim MsgStr As String
Dim ws As Worksheet, r As Range, g As Range
Set ws = wb.Sheets("Allotment hotel")
Set r = ws.Range("B50").Cells
Set g = ws.Range("D50").Cells
If r <> "" And g = "" Then
MsgStr = "Room type was not found in the sheet 'Allotment hotel'"
End If
Sub check()
Dim msg As String
Dim rng As Range
Set rng = Sheets("Allotment hotel").Range("B50:B53")
For Each cell In rng
If Not IsEmpty(cell) Then
If IsEmpty(cell.Offset(0, 2)) Then
msg = "Whatever String you want"
End If
End If
Next cell
End Sub
Or make a Named Range for cells B50:B53, lets call it checkrng
Set rng = Sheets("Allotment hotel").Range("checkrng")
Related
I have a TON of headers that I need to assign to a worksheet, but I'm doing it with just a select few to test out. What I am trying to do is assign 4 cells in a range, and also assign 4 text values for each concurrent cell in that predefined range.
Dim rng As Range: Set rng = Range("E3,O3,AF3:AG3")
Dim header() As Variant: header() = Array("Department Name", "Hire Date (Most Recent)", "Region", "District")
For Each cell In rng
Cell.Value = header(i)
Next cell
it works well for the first one Department Name, but then it exits out of the loop in the next go-around and moves on to the rest of the code, any clue how I can alter it to cycle through and label appropriately?
rest of code (partial):
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Corporate", "OtherCorporate", "DC", "Stores", "Hires"
With ws
Dim i As Long, cell As Range, rng As Range
Dim header() As Variant: header() = Array("Department Name", "Hire Date (Most Recent)", "Region", "District")
.Range("L:M, R:T, AC:AG, AJ:AK, AR:BF").EntireColumn.Delete Shift:=xlToLeft
.Range("I:I, M:N, AN:AO").EntireColumn.Hidden = True
Set rng = Range("E3,O3,AF3:AG3")
For Each cell In rng
i = 1
cell.Value = header(i)
i = i + 1
Next cell
End With
in a worksheet I want to select the inputbox's input i.e. suppose "A" which is incurred in multiple cells in multiple location. I want to select all the cells referring to letter "A" at the same time.
Option Explicit
Sub SelectBattleship()
Dim BattleShip As Range
Dim Name As String
Dim store As Variant
Dim cell As Range
Set BattleShip = Range("A1:J10")
Name = InputBox("Value?")
For Each cell In BattleShip
If cell = Name Then
store = cell.AddressLocal & cell.AddressLocal
End If
Next cell
store.Select
End Sub
I expect all the cells containing the letter "A" will be selected together.
Build a Union() and use it:
Option Explicit
Sub SelectBattleship()
Dim BattleShip As Range
Dim Name As String
Dim store As Variant
Dim cell As Range, rSelect As Range
Set BattleShip = Range("A1:J10")
Name = InputBox("Value?")
For Each cell In BattleShip
If cell.Value = Name Then
If rSelect Is Nothing Then
Set rSelect = cell
Else
Set rSelect = Union(rSelect, cell)
End If
End If
Next cell
If rSelect Is Nothing Then
Else
rSelect.Select
End If
End Sub
Basically, I'm trying to create a "Data Entry" tab. I have two data validation entry boxes that withdraw data dynamically from a table. The first cell indexes based on persons last name (Table2[LAST]). The second cell indexes Table1[#HEADERS]. While these are all fine and dandy, I need to enter the worksheet cell where those two intersect and turn that intersected cell into data from a cell on my data entry sheet.
Cell "B2" on worksheet1 is Data Validation Type list with dropdown from Table2[Last] (In worksheet2)
Cell "C2" on worksheet1 is Data Validation Type list with dropdown from Table1[#HEADERS] (In worksheet2)
Cell "D2" on worksheet1 is Data Validation Type "Date" and is what will be pushed to the intersecting cell on worksheet2 when I push the button. The code below is stuff I've found and stuck together and I just can't figure out why it fails on the final line.
Sub Button5_Click()
Dim wsInfo As Worksheet: Set wsInfo = Worksheets("worksheet2")
Dim lookupRange As Range
Dim matchval As Range
Dim indexVar As Long
Dim myVal As Variant
Dim matchval2 As Range
Dim lookuprange2 As Range
Set matchval = Sheets("worksheet1").Range("B2")
Set lookupRange = wsInfo.Range("Table2[LAST]")
If Not Application.WorksheetFunction.Sum(lookupRange) = 0 Then
indexVar = Range(Application.Index(lookupRange, Application.Match(matchval, lookupRange))).Row
End If
Set matchval2 = Sheets("worksheet1").Range("B3")
Set lookuprange2 = wsInfo.Range("Table1[#HEADERS]")
If Not Application.WorksheetFunction.Sum(lookupRange) = 0 Then
columnVar = Range(Application.Index(lookupRange, Application.Match(matchval2, lookuprange2))).Column
End If
wsInfo.Cells(indexVar, columnVar) = Sheets("worksheet1").Cells(2, "D").Value
End Sub
If there's an easier method for the data validation list to just give a relative reference, I can use that. It would also account for duplicate last names.
Thanks to SJR for pointing me in the correct direction.
Sub Button5_Click()
Dim wsInfo As Worksheet: Set wsInfo = Worksheets("worksheet2")
Dim pltws As Worksheet: Set pltws = Worksheets("Data Entry Tab")
Dim lookupRange As Range
Dim myVal As Variant
Dim lookuprange2 As Range
'Set row value to look for
matchval = pltws.Cells(2, "B").Value
'Set column to look in
Set lookupRange = wsInfo.Range("Table2[LAST]")
'Set column value to look for
matchval2 = pltws.Cells(2, "C").Value
'Set row to look in
Set lookuprange2 = wsInfo.Range("Table1[#HEADERS]")
'Returns row (Relative to the actual range provided, not the worksheet) that data is found on
indexVar = Application.Match(matchval, lookupRange, 0)
'Returns column (Also relative to the range provided, not the worksheet) that the data is found in
columnVar = Application.Match(matchval2, lookuprange2, 0)
'Have to offset to account for actual tables position in the worksheet.
wsInfo.Cells(indexVar + 3, columnVar + 3).Value = pltws.Cells(2, "D").Value
End Sub
I'm currently working on the statement that implies, that if any of the cell value in the range of "G3:ED3" in the worksheet named "Matrix", matches the cell value in the range of "H3:H204" in the worksheet named "Staff" and any cell value in the range "G5:ED57" in the "Matrix" worksheet is numeric, then the value of the cell in a column B, that intersects the numeric value, is retrieving to the required cell address in the target template.
Here's what I have tried so far:
Dim rng1 As Range
Set rng1 = Worksheets("Matrix").Range("G3:ED3")
Dim rng2 As Range
Set rng2 = Worksheets("Staff").Range("H3:H204")
Dim rng3 As Range
Set rng3 = Worksheets("Matrix").Range("G5:ED57")
For Each cell In Range(rng1, rng2, rng3)
While IsNumeric(rng3) And rng1.Value = rng2.Value
Worksheets("Matrix").Columns("B").Find(0).Row =
Worksheets("TEMPLATE_TARGET").Value(12, 4)
Wend
I'm unsure how to define the statement, so the code would automatically retrieve the value of the cell in a column B, that intersects any cell that contains numeric value in the rng3. Any recommendations would be highly appreciated.
it's probably best you take a proper look into documentation / whatever learning resource you are using as you seem to have missunderstood how While works (alongside few other things)
While is a loop within itself, it does not act as an Exit Condition for the For loop.
With all that said, it's also unclear from your question what you're trying to achieve.
My presumption is, that you want to check for all the conditions and
then if they do match, you're looking to paste the result into the
"TEMPLATE" sheet
First we create a function th ceck for values in the two data ranges:
Private Function IsInColumn(ByVal value As Variant, ByVal inSheet As String) As Boolean
Dim searchrange As Range
On Error Resume Next ' disables error checking (Subscript out of range if sheet not found)
' the range we search in
If Trim(LCase(inSheet)) = "matrix" Then
Set searchrange = Sheets("Matrix").Range("G5:ED7")
ElseIf Trim(LCase(inSheet)) = "staff" Then
Set searchrange = Sheets("Staff").Range("H3:H204")
Else
MsgBox ("Sheet: " & inSheet & " was not found")
Exit Function
End If
On Error GoTo 0 ' re-enable error checking
Dim result As Range
Set result = searchrange.Find(What:=value, LookIn:=xlValues, LookAt:=xlWhole)
' Find returns the find to a Range called result
If result Is Nothing Then
IsInColumn = False ' if not found is search range, return false
Else
If IsNumeric(result) Then ' check for number
IsInColumn = True ' ding ding ding, match was found
Else
IsInColumn = False ' if it's not a number
End If
End If
End Function
And then we run the procedure for our search.
Private Sub check_in_column()
Dim looprange As Range: Set looprange = Sheets("Matrix").Range("G3:ED3")
Dim last_row As Long
For Each cell In looprange ' loops through all the cells in looprange
'utlizes our created IsInColumn function
If IsInColumn(cell.Value2, "Matrix") = True And _
IsInColumn(cell.Value2, "Staff") = True Then
' finds last actively used row in TEMPLATE_TARGET
last_row = Sheets("TEMPLATE_TARGET").Cells(Rows.Count, "A").End(xlUp).Row
' pastes the found value
Sheets("TEMPLATE_TARGET").Cells(last_row, "A") = cell.Value2
End If
' otherwise go to next cell
Next cell
End Sub
I redefined your ranges a little in my example for utility reasons but it works as expected
In my Matrix sheet: (staff sheet only contains copy of this table)
In my TEMPLATE_TARGET sheet after running the procedure.
Result as expected
If I understand well, I would have done something like this:
Option Explicit
Public Sub Main()
Dim wsMatrix As Worksheet: Set wsMatrix = ThisWorkbook.Worksheets("Matrix")
Dim rgMatrix As Range: Set rgMatrix = wsMatrix.Range("G3:ED3")
Dim cell As Range
Dim cellStaff As Range
Dim cellMatrix As Range
For Each cell In rgMatrix
If CheckRangeStaff(cell.Range) And CheckRangeMatrix() Then
'Process in a column B? Which sheet? Which cell? Which Process?
End If
Next cell
Debug.Print ("End program.")
End Sub
Public Function CheckRangeStaff(ByVal value As String) As Boolean
Dim wsStaff As Worksheet: Set wsStaff = ThisWorkbook.Worksheets("Staff")
Dim rgStaff As Range: Set rgStaff = wsStaff.Range("H3:H204")
Dim res As Boolean
Dim cell As Range
res = False
For Each cell In rgStaff
If cell.value = value Then
res = True
Exit For
End If
Next cell
CheckRangeStaff = res
End Function
Public Function CheckRangeMatrix() As Boolean
Dim wsMatrix As Worksheet: Set wsMatrix = ThisWorkbook.Worksheets("Matrix")
Dim rgMatrix As Range: Set rgMatrix = wsMatrix.Range("G5:ED57")
Dim res As Boolean
Dim cell As Range
res = False
For Each cell In rgMatrix
If IsNumeric(cell.value) Then
res = True
Exit For
End If
Next cell
CheckRangeMatrix = res
End Function
Below is the code I have so far. I am trying to do the following:
Compare the "ICT number" to the name of worksheet and if that worksheet name contains the ICT number, even if it is mixed in with other string values, then i want to look at a certain cell in that worksheet and compare the value in that cell with a cell in my checklist worksheet.
If those values are the same, then i want to have a message come up in a corresponding cell on that row saying that the two sources reconcile.
I then want this to loop for all of the rows in the checklist worksheet and all of the worksheets in the workbook.
Dim ICT_Number As Range
Dim statmentdata As Range
Dim checklistdata As Range
Dim Worksheet As Variant
Dim reconcile As Range
For Each cell In Range("d6:d236")
Set ICT_Number = ActiveCell
Set statementdata = Worksheets("m0017 v p0903").Range("H2016")
Set checklistdata = ActiveCell.Offset(0, 5)
Set currsheet = Worksheets("m0017 v p0903")
Set reconcile = ActiveCell.Offset(0, 11)
If InStr(1, cell, ICT_Number, 1) Then
If statmentdata = checklistdata Then
reconclie.Value = "this line reconiles"
Else
reconcile.Value = "this line does not reconclie"
End If
Next cell
End Sub
You have several issues in your code:
Don't use protected (or ambiguous) names for your variables.
Please DON'T DO:
Dim Worksheet As Variant
Better do:
Dim ws as Worksheet
Use Set when assigning an object
This WON'T work:
currsheet = Worksheets("statement n0246 v ab119")
Instead, do:
Set currsheet = Worksheets("statement n0246 v ab119")
What your code could look like
Sub test()
Dim ICT_Number As Range
Dim statmentdata As Range
Dim checklistdata As Range
Dim Worksheet As Variant
Dim reconcile As Range
Set ICT_Number = Worksheets("checklist").Range("D79")
Set statementdata = Worksheets("n0246 v ab119").Range("H2016")
Set checklistdata = Worksheets("checklist").Range("H79")
Set currsheet = Worksheets("statement n0246 v ab119")
Set reconcile = Worksheets("checklist").Range("N79")
If currsheet.Name = ICT_Number Then
If statmentdata = checklistdata Then
reconclie.Value = "this line reconiles"
Else
reconcile.Value = "this line does not reconclie"
End If
End If
End Sub
Before anything else
Please have a look at a VBA Tutorial to learn the syntax: VBA: Basic Syntax and Examples Tutorial