I am trying to put the value of a cell in a Msgbox that is in the left column (column A). This value needs to be picked though, depending on which value in column B is the lowest and it should be reused, with varying length of the rows (sometimes it is 200 rows sometimes 230 etc.)
So far I wrote:
Sub Flow()
'Check lowest value
Dim lowestValue As String
lowestValue = Application.WorksheetFunction.Min(Sheets("ImportData").Range("B3:B290"))
MsgBox "Lowest Flow" & vbNewLine & _
(lowestValue) & vbNewLine & _
"at " & (lowestValue.Offset(0, -1))
End Sub
Obviously lowestValue.Offset(0, -1)) does not work, but basically that is what I would like to achieve: find the lowestValue and then look one column to the left and also display that value in the cell.
Here's one way:
Sub Flow()
'Check lowest value
Dim rData As Range
Dim lowestMatch
Set rData = Sheets("ImportData").Range("B3:B290")
lowestMatch = Application.Match(Application.Min(rData), rData, 0)
If Not IsError(lowestMatch) Then
MsgBox "Lowest Flow" & vbNewLine & _
rData.Cells(lowestMatch).Value & vbNewLine & _
"at " & rData.Cells(lowestMatch).Offset(0, -1).Value
End If
End Sub
Related
I have an excel-workbook containing two worksheets, and I have written code to transfer data from sheet No.1 to sheet No.2.
What I need is to include a condition that checks if the column G does not contain a certain value. In that case I would like a MsgBox to display "Check..".
The interested range in the Sheet 1 is (A3:J50), so the condition would interest cells G3 to G50.
My current code is:
Sub kk()
Dim lastrow As Integer
lastrow = [b50].End(xlUp).Row
Range("b3:J" & lastrow).Copy Sheets("Daily Rec.").Range("b" & Sheets("Daily Rec.").[b1000].End(xlUp).Row + 1)
Range("b3:j" & lastrow).ClearContents
MsgBox ("Date Posted")
Sheets("Daily Rec.").Activate
MsgBox ("Check..")
End Sub
please advice
This should help get you started.
But like others have mentioned, we need more info to help.
Sub Okay()
Dim source As Range
Dim target As Range
Dim found As Range
Dim cell As Range
Set source = ThisWorkbook.Worksheets("Sheet 1").Range("A3:J50")
Set target = ThisWorkbook.Worksheets("Sheet 2").Range("G3:G50")
For Each cell In source.Cells
Set found = target.Find(cell.Value)
If found Is Nothing Then
MsgBox "Check.." & vbNewLine _
& "Cell [" & cell.Address(0, 0) & "] on sheet [" & cell.Parent.Name & "]" _
& vbNewLine _
& "was not found within " & vbNewLine _
& "cell range of [" & target.Address(0, 0) & "] on sheet [" & target.Parent.Name & "]"
End If
Next cell
End Sub
I have a script that allows a user to select a column with their mouse. Then, the user selects whether or not that column has a Header. How can I define the column number of the range that is selected so that I can perform functions on it like:
usc = rng.columns
For i = 2 to lastrow
cells(i,usc + 1).Value = left(Cells(i,usc),2)
next i
The script I have is below. Any help would be greatly appreciated!
Set rng = Application.InputBox( _
Prompt:="Please select your target column. " & vbNewLine & _
" (e.g. Column A or Column B)", _
Title:="Select Column", Type:=8)
On Error GoTo 0
hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option")
try this
Sub test()
Set Rng = Application.InputBox("Please select your target column. " & Chr(10) & _
" (e.g. Column A or Column B)", "Select Column", , , , , , 8)
MsgBox "Selected column is: " & Rng.Column & Chr(10) & "Selected row is: " & Rng.Row
End Sub
result
I've been looking to write a macro to check 3 columns to ensure the contents are a date value. The columns can contain empty cells.
The below returns a message box for each cell that is not a date, even the blanks.
Sub DateCheck()
With ActiveSheet
lastRow = .Range("AB" & Rows.Count).End(xlUp).Row
For RowCount = 2 To lastRow
POC = .Range("AB" & RowCount)
If Not IsDate(POC) Then
MsgBox ("Please enter valid date in Cell : AB" & RowCount & ". Example: dd/mm/yyyy")
End If
Next RowCount
End With
End Sub
Could anybody be so kind as to help to adjust this to look at 3 non-adjacent columns, ignore blank cells and only return one message per column in the event it finds non-date values?
Thanks as always
Chris
Code:
Sub DateCheck()
Dim s(2) As String
Dim i As Integer
Dim o As String
Dim lastRow As Long
Dim r As Long
'Enter columns here:
s(0) = "A"
s(1) = "B"
s(2) = "C"
For i = 0 To 2
With ActiveSheet
lastRow = .Range(s(i) & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
POC = .Range(s(i) & r)
If Not IsDate(POC) Then
o = o & ", " & .Range(s(i) & r).Address
End If
Next r
MsgBox ("Please enter valid date in Cells : " & Right(o, Len(o) - 1) & ". Example: dd/mm/yyyy")
o = ""
End With
Next i
End Sub
I would change your loop to a For Each In ... Next and use .Union to construct a range of non-adjacent columns.
Sub MultiDateCheck()
Dim lr As Long, cl As Range, rng As Range, mssg As String
With ActiveSheet
lr = .Range("AB" & Rows.Count).End(xlUp).Row
Set rng = Union(.Range("AB2:AB" & lr), .Range("AM2:AM" & lr), .Range("AZ2:AZ" & lr))
For Each cl In rng
If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _
mssg = mssg & cl.Address(0, 0) & Space(4)
Next cl
End With
If CBool(Len(mssg)) Then
MsgBox ("Please enter valid date(s) in Cell(s): " & Chr(10) & Chr(10) & _
mssg & Chr(10) & Chr(10) & _
"Example: dd/mm/yyyy")
Else
MsgBox "All dates completed!"
End If
Set rng = Nothing
End Sub
I've used a single lastrow from column AB to determined the scope of the cells to be examined but individual rows for each column could easily be compensated for.
Addendum: Code modified for a single message showing rogue non-date/non-blank cells (as below). The Chr(10) is simply a line feed character.
I'm quite new to excel and have been trying to get this Countif formula to work for a while now. I want it to count from the 12th row in column AN p till the last used row. I am very close now but when I run the macro it gives me a REF error.
Sub Date1()
'
' Enter Date
'
Range("B15") = InputBox("Enter Date")
Dim LR As Long
LR = Sheets("Design Risk Scoring Sheet").Range("AN" & Rows.count).End(xlUp).Row
Range("B16").FormulaR1C1 = _
"=COUNTIF('Design Risk Scoring Sheet'!R[-4]C[38]:RC[38](" & LR & "), ""<"" & R[-1]C )"
End Sub
This is what i get in the formula cell when I run the macro
=COUNTIF('Design Risk Scoring Sheet'!AN12:AN16(163), "<" & B15 )
It should ideally be AN163 instead of 16. I have tried removing RC[38] and putting AN instead but i get AN(163) which gives a #NAME error and if i remove the brackets in (" & LR & ") then I get single quotation marks in the formula :
=COUNTIF('Design Risk Scoring Sheet'!AN12:'AN163', "<" & B15 )
I dont know how to fix this problem?
Alternate:
Sub Date1()
Dim sDate As String
sDate = InputBox("Enter Date", "Date Entry", Format(Now, "m/d/yyyy"))
If Len(sDate) = 0 Then Exit Sub 'Pressed cancel
If Not IsDate(sDate) Then
MsgBox "[" & sDate & "] is not a valid date.", , "Exiting Macro"
Exit Sub
End If
Range("B15").Value2 = DateValue(sDate)
Range("B16").Formula = "=COUNTIF(AN12:AN" & Cells(Rows.Count, "AN").End(xlUp).Row & ",""<""&B15)"
End Sub
Try This..
Range("B16").FormulaR1C1 = _
"=COUNTIF('Design Risk Scoring Sheet'!R[-4]C[38]:RC[38](" & LR & "), < & R[-1]C )"
I am trying to select and copy some selected area of a pivot table. I am able to determine the amount of area I want and am able to display the range in a message box which is not my objective. I want to copy that selected range. My code looks like this.
I want to copy the Values in the range (toprow1,leftcoloumn:lastrow,rightcoloumn).
FYI the message box code is something I don't need Its just their to tell you the Range no.
Sub PivotTableRangeAreas()
With ActiveSheet.PivotTables(1)
Dim TopRow1 As Long, TopRow2 As Long, LastRow As Long
Dim LeftColumn As Long, RightColumn As Long
TopRow2 = .TableRange2.Row
With .TableRange1
TopRow1 = .Row
LastRow = .Rows.Count + .Row - 1
LeftColumn = .Column
RightColumn = .Columns.Count + .Column - 1
End With
MsgBox "The pivot table named " & .Name & vbCrLf & _
"occupies these range elements:" & vbCrLf & vbCrLf & _
"With the Report (Page) field: " & vbCrLf & _
.TableRange2.Address(0, 0) & vbCrLf & _
"Without the Report (Page) field: " & vbCrLf & _
.TableRange1.Address(0, 0) & vbCrLf & vbCrLf & _
"First row, with the Report (Page) field: " & TopRow2 & vbCrLf & _
"First row, without the Report (Page) field: " & TopRow1 & vbCrLf & _
"Last row: " & LastRow & vbCrLf & _
"Left column: " & LeftColumn & vbCrLf & _
"Right column: " & RightColumn, , "Pivot table location."
End With
End Sub
I'm guessing it's just the values that you want to copy? If so, try starting with something like this - it'll put the values into Sheet2 starting at range A1. I'm not sure which range from the pivot table you want to copy to where - you'll have to change some of this to suit:
Sub CopyRange()
Dim vArray() As Variant
'Copies the values between (Toprow1, LeftColumn) and (LastRow, RightColumn) into an array
vArray = ActiveSheet.Range(Cells(TopRow1, LeftColumn), Cells(LastRow, RightColumn)).Value
'Pastes the values from the array into Sheet2, starting at A1
Sheet2.Range("A1").Resize(UBound(vArray, 1), UBound(vArray, 2)).Value = vArray
End Sub