What's the difference between accessing a row's cells these ways:
Sub test6()
Dim wRange As Range
Set wRange = Range("B3:P10")
For Each aRow In wRange.Rows
'need to get this row's second column (B)
Cells(aRow.Row, 4).value = aRow.Cells(1, 2).Address
Cells(aRow.Row, 5).value = Cells(aRow.Row, 2).Address
Next
End Sub
I get weird results, depending on the range. Besides I have a more complex program that also gives different results when using these two methods.
I changed your procedure a bit and added the output of Debug.Print as comment to better explain why this is an expected result:
Option Explicit 'in the first line of your modules: Ensures you need to declare all variables
Sub test6()
Dim wRange As Range, aRow As Variant
Set wRange = Range("B3:P10")
For Each aRow In wRange.Rows
' Outputs of the first loop run:
Debug.Print aRow.Address ' $B$3:$P$3
Debug.Print aRow.Cells(1, 2).Address ' $C$3
Debug.Print Cells(aRow.Row, 2).Address ' $B$3
Next
End Sub
Explanationː
aRow is a sub range ($B$3:$P$3) out of the original range B3:P10 containing only one row (but not an entire row of the worksheet as you assume) so aRow.Cells(1, 2) refers to column 2 relative to aRow which is C because the range is starting with B not with A.
Cells(aRow.Row, 2) is exactly the same as writing ActiveSheet.Cells(aRow.Row, 2) and refers to column 2 relative to the ActiveSheet which is B because the range of the sheet is starting at A.
aRow.EntireRow.Cells(1, 2).Address would be the same as Cells(aRow.Row, 2).Address because now we refer to the entire row starting at column A.
Side note:
I recommend not to assume the worksheet and fully qualify your cells/ranges so you always see to which range the cells are relative to.
Your result isn't weird, because aRow.Cells().Address returns an address, relative to column B, since first column of wRange is B too.
So in your case you need this line instead:
...
'need to get this row's second column (B)
Cells(AROW.Row, 4).Value = AROW.Cells(1, 1).Address
'^ relative index
...
And when you use this property without an object qualifier (simply Cells()) - this gives your a result relative to entire active worksheet!
The RowIndex and ColumnIndex arguments are relative offsets.
Cells(aRow.Row, 4) refers to the cells of the ActiveSheet. aRow.Cells(1, 2) refers to a cell in teh aRow range.
Related
I have a project that I am working on where multiple conditions are checked across all rows and many columns. The issue is that columns are added/removed from the sheet, and, at present, that results in all of my cell(row,column) references being off + outputting incorrect information. I'm wondering if there's a way to make my column references more robust so that they automatically find the correct headers and use them when checking? Would a solution to this problem be able to account for multiple columns containing the exact same header text?
Basically:
No blank columns
Column headers have repeats (e.g., Column 1 header: "Financials"; Column 15 header: "Financials")
Columns are shifting right and left based on adding/removing columns from sheet
Please find a short sample of my current code below with notes:
Dim i As Integer
Dim lastRow As Long
Dim lastCol As Long
lastRow = Range("A1").End(xlDown).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
Select Case Cells(i, 14).Value
Case Is = "Yes"
Select Case True
Case Cells(i, 63).Value = 6 And _
(IsEmpty(Cells(i, 77)) Or IsEmpty(Cells(i, 93)) Or IsEmpty(Cells(i, 109)) Or _
IsEmpty(Cells(i, 125)) Or IsEmpty(Cells(i, 141)) Or IsEmpty(Cells(i, 157)))
Cells(i, 174).Value = "True" '^THESE CELL VALUES ALL HAVE THE SAME COLUMN HEADER TITLE
If the table is consistent - starting at A1 and occupying a contiguous block - then Range("A1").CurrentRegion will reference the table.
You can then use .CreateNames to name the columns (that is, using Named Ranges) according to their headings.
Dim rngTable As Range
Dim rng As Range
Set rngTable = Range("A1").CurrentRegion
rngTable.CreateNames True, False, False, False
' that is, based on the first row headings
Range("Salary").Select 'prove it works
'if necessary, iterate the cells of the column,
For Each rng In Range("Salary")
rng.Value = rng.Value + 10
Next 'rng
If a column heading is duplicated ("Financial"), though, then you'll be asked to confirm and the second occurrence will overrule the first. (Or you could say "No" and the first occurrence will be named.) In which case, it is preferable that you first correct these duplicate headings.
Correcting the duplicate headings is not necessarily straight forward, but something that you should resolve anyway. If it is a specific word "Financials" (or words) that could be duplicated then this makes the task easier. You could count how many occurrences there are, and correct the second, etc., to "Financials2".
One easy way to to assign a Name to the column. Say column N has the header "Payments". First assign the Name "Payments" to that column:
Then in VBA we can code like:
Sub dural()
Dim rng As Range, colly As Long
Set rng = Range("Payments")
colly = rng.Column
For i = 2 To 100
If Cells(i, colly) = "whatever" Then
MsgBox "Help"
End If
Next i
End Sub
The code will continue to work even if you add/remove columns beforre column N.
I have tried to make a loop (I'm very new to the VBA) that check for the word "Apple" in column A. Column A contains fruit names. When "Apple" is found, then the code is copying range "H2:S2" to Column G and the corresponding row value in Column A.
But the code will not run when the search criteria part is changed to wildcard (My goal is to include rows where the word Applecake exist).
lookupVal = "Apple" 'Works
lookupVal = "*Apple*" 'Nothing happens
How should I adjust the code below so it runs with wildcard or maybe there are a better solution than this code states to achieve the result?
Full code:
Sub CopypasteValues()
Dim i, j, lastrowA As Long
Dim lookupVal As String
'finds the last row in Column A
lastrowA = Sheets("Dataset").Cells(Rows.Count, "A").End(xlUp).Row
'loop over values in Sheet "Dataset"
For i = 1 To lastrowA
lookupVal = "Apple" 'Define search critera
For j = 1 To lastrowA
currVal = Sheets("Dataset").Cells(j, "A")
If lookupVal = currVal Then
ValueCopy = Range("G2:S2").Copy 'Range to copy
Sheets("Dataset").Cells(j, "G") = Range("G" & j).PasteSpecial
End If
Next j
Next i
End Sub
You can use the Like operator:
If currVal Like lookupVal Then
So, if lookupVal was "*Apple*" and currVal was "Aren't Apples nice to eat", the test would be True.
You might also need to use
If LCase$(currVal) Like LCase$(lookupVal) Then
if you want to avoid case-sensitivity problems.
You could also consider using Find (with a LookAt:=xlPart or LookAt:=xlWhole parameter as required), rather than doing a cell-by-cell comparison. But it would depend on exactly what your requirements are as to whether that was a feasible solution.
I am trying to convert the used range of a column to hourly data using floor.
As a function in Excel I have =FLOOR(A2, "1:00")
So 2016-07-01 07:59:59.0000000 would become 01-07/2016 7:00
I would like to do this in VBA for just Column A where the first row is a header. I guess I'd need to convert to dateTime afterwards to but haven't thought about that yet (shouldn't be difficult).
I have tried this:
.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) = _
Application.WorksheetFunction.Floor(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp), "1:00")
But get wrong number of arguments error.
This:
.Range("A:A") = Application.WorksheetFunction.Floor("A:A", "1:00")
gives a type mismatch.
Not sure how to proceed.
The WorksheetFunction.Floor Method in VBA is a little different from the worksheets =Floor function:
WorksheetFunction.Floor(Arg1, Arg2)
Both arguments Arg1 and Arg2 need to be of the type double.
So you will need to use 1/24 instead of "1:00" (which is the same because 1 hour is 1/24 of a day) and a value .Cells(i, "A").Value instead of a cell reference name "A:A".
Also you will need a loop to achieve it for every used cell in the whole column A.
Option Explicit 'First line at your module ensures you declare any variables
Public Sub FloorFormat()
Dim lastRow As Long
With Worksheets("Sheet1") 'Your sheet name here
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 'find last used row
Dim i As Long
For i = 1 To lastRow 'do the following for all used rows in column A
.Cells(i, "A").Value = Application.WorksheetFunction.Floor(.Cells(i, "A").Value, 1 / 24)
Next i
End With
End Sub
I initially asked a question below.
Basically I want VBA to look at Column L:L. If the cell=program, and the cell below does not equal lathe I want the row above to be deleted. If the cell doesn't equal program continue looking until the end of the data.
Realized I needed to look at the data different, as I was losing rows that I needed to stay.
New logic, which I think will still use some of the old program, but
it needed to be sorted using another column. I need the VBA to look at
column E:E. If the cell in the row below is a duplicate of the cell
above, then look at column L in that row to see if the cell says
Program. If so the cell below should be Lathe. If not lathe delete the
Program Row, If it is Lathe leave both rows. If the Cells in Column E
are not duplicates, continue looking. EX. If E5=E6, If not continue
looking. If yes Look at L5 to see if it say Program. If so look at L6
for Lathe. If not delete ROW5.
This I what I received that answered teh first question which I think will still get used
Dim rngCheck as Range
Dim rngCell as Range
Set rngCheck = Range("L1", "L" & Rows.Count - 1)
For each rngCell in rngCheck
If rngCell.value = "Program" And rngCell.offset(1,0).value <> "lathe" then
rngCell.offset(-1,0).EntireRow.Delete
End if
Next rngCell
This should do it
For i = ThisWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row to 2 step -1
' that row do you mean the duplicate or the original (I am using original)
If ThisWorksheet.Cells(i, 5) = ThisWorksheet.Cells(i-1, 5) and _
ThisWorksheet.Cells(i-1, 12) = "Program" and ThisWorksheet.Cells(i, 12) <> "Lathe"
ThisWorksheet.Rows(i-1).EntireRow.Delete
End If
Next i
When deleting it is best to iterate from last to first. If prevent you from skipping rows.
Sub RemoveRows()
Dim x As Long
With Worksheets("Sheet1")
For x = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(x, "E").Value = .Cells(x - 1, "E").Value And Cells(x - 1, "L").Value = "Program" Then
.Rows(x).Delete
End If
Next
End With
End Sub
I have a list of query words that I am submitting to a database (Column A) to generate a list of coded matches (Columns F-H). Column F is the original search word (so there is an exact match somewhere in Column A), Column G contains the match, and Column H contains the code for the match. What I need to do is take the query word in Column F and find its partner in Column A. Then I need to take the corresponding match and its code and paste it next to the original search term in Column A (in Columns B&C).
My problem here is getting the information pasted in the correct cell since the copy to and paste from locations change every time -- The list of coded matches in Columns F-H does NOT contain all of the terms in Column A.
I've been searching the internet and I can't seem to figure out what exactly I need to change to allow the paste function to work.
I have attached an image of a simplified version of my spreadsheet and a annotated version of the code I have been working with.
Sub FindMatch()
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To LastRow
FindMe = Cells(i, 6).Value
Set FoundinList = Cells.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
If Not FoundinList Is Nothing Then
FoundinList.Select
ActiveCell.Offset(0, 1).Select
'At this point the cell I want the information pasted into is selected. Yay!
'Example: I am trying to find "abnormal digits" (F1) in Column A and paste
'G1:H1 into the appropriate cells in Columns B & C (In this case B15:C15)
'At this point in the code my cursor is on cell B15 - which is where I need it.
Range(Cells(i, 7), Cells(i, 8)).Copy
'This selects the appropriate range (G1:H1 in my example).
ActiveCell.Paste
'This is the problem string. I've tried naming the "ActiveCell" before initiating the copy
'string (ActiveCell.Name = "PasteHere") and then pasting into the named cell
'(Cells("PasteHere").Paste), but that gives me an invalid procedure call or argument on:
'Cells("PasteHere").Paste I've also tried pasting into a range:Range(Cells(PasteHere, 2)
', Cells(PasteHere, 3)).Paste -AND- using the formula that is created when you a record a
'macro (Application.CutCopyMode = False) but both of those give me an application
'/object-defined error.
End If
Next i
End sub
Thank you so much in advance for reading this post and helping me out.
My Spreadsheet
End Product
This vba uses the worksheet function vlookup.
Sub ahhn()
Dim ws As Worksheet
Dim cel As Range
Set ws = ActiveSheet
With ws
For Each cel In .Range(.Range("A1"), .Range("A1").End(xlDown))
cel.Offset(0, 1) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 2, 0), "")
cel.Offset(0, 2) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 3, 0), "")
Next
End With
End Sub