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
Related
I have a sub-routine that searches for the first available cell in the first column that is empty. I would like to insert a String into this cell.
What's the best way to do this? I have tried like this:
Range(NextEmptyCol).Value = "New Query"
Here is my sub-routine:
Sub CreateNewQuery()
Dim NextEmptyCol As Long
Sheets("DataFeedSheet").Activate
NextEmptyCol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column + 1
' MsgBox "Column number " & NextEmptyCol & vbCr & _
' "Or column letter """ & Replace(Cells(1, NextEmptyCol).Address(0, 0), 1, "") & """", _
' vbInformation, "The Next Empty Column is..."
Range(NextEmptyCol).Value = "New Query"
End Sub
Maybe this is what you are looking for
Sub CreateNewQuery()
Dim NextEmptyCol As Long
Sheets("Sheet2").Activate
NextEmptyCol = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Column + 1
' MsgBox "Column number " & NextEmptyCol & vbCr & _
' "Or column letter """ & Replace(Cells(1, NextEmptyCol).Address(0, 0), 1, "") & """", _
' vbInformation, "The Next Empty Column is..."
Cells(1, NextEmptyCol).Value = "New Query"
End Sub
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 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
I'm still quite new to VBA and struggling with the following code!
What I am trying to do is have the search function look through all cells within column 1 and find the criteria of Cell 1 matches PickerName2.Text and offset cell 5 is <>0 and then offset cell 6 = Blank
The problem I have is there a duplicates all the way down column 1 and as soon as it finds the matching name to PickerName2 Then it checks the offset cells 5 & 6 and as these don't match the criteria it gives the message they aren't currently picking.
This is even though further down the sheet there is a record that matches the criteria. I want it to look through all records until it find the criteria or if it has checked all populated cells in column A and nothing matches then it will give the message that they aren't currently picking.
I do hope someone can help :-)
Al
Private Sub CommandButton3_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim strSearch As String
Dim aCell As Range
Dim rng As Range, i As Long
'~~> Set the sheet where you want to search the IMEI
Set ws = Sheets("PickData")
With ws
'~~> Get the value which you want to search
strSearch = PickerName2.Text
'~~> Column A is Column 1 so Column B is 2. This is where we are searching
'~~> xlWhole is used in the code below so that we find a complete match
'~~> xlPart is supposed to be used when you are finding a partial match.
Set aCell = .Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'~~> get the row of the cell where we found the match and add data to
If Not aCell Is Nothing And aCell.Offset(0, 5).Value <> "" And aCell.Offset(0, 6).Value = "" Then
MsgBox " " & PickerName2.Text & " is currently picking - " & aCell.Offset(0, 1) & " " & aCell.Offset(0, 2) _
& " " & aCell.Offset(0, 3) _
& " "
UserForm1.Hide
Else
MsgBox " " & PickerName2.Text & " has no outstanding PIK!", vbExclamation
PickerName2.Value = ""
Exit Sub
End If
End With
PickNo2.Value = ""
PickerName2.Value = ""
UserForm1.Hide
End Sub
I have done some searching online and tried something similar to the following code but keep getting a object required error but cannot see where I am going wrong?
Dim rng As Range
Dim i As Integer
Dim finalrow As Integer
finalrow = Sheets("PickData").Range("A10000").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 1).Value = UserForm1.PickerName2.Text And (Cell.Offset(i, 5) <> "") And (Cell.Offset(i, 6) = "") Then
MsgBox " " & PickerName2.Text & " is currently picking - " & Cell.Offset(i, 1) & " " & Cell.Offset(i, 2) _
& " " & Cell.Offset(i, 3) _
& " "
End If
Next i
Your first code attempt using the Range.Find method is a good start.
Now extend this approach by using the Range.FindNext method.
This link should help you.
In your second block of code:
The references to Cell.Offset... should probably be something like Cells(i,1).Offset(0,5) and Cells(i,1).Offset(0,1) and Cells(i,1).Offset(0,3) respectively.
Also the second reference to PickerName2 should be qualified with UserForm1, as in UserForm1.PickerName2
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