All, I am working part of my code where I want to update filtered noncontiguous cells with index / match. Core of my code is working in proper manner in another case but here seems wrong and do not know what is the reason behind. Working turn endless and could cause that no last row find in section here: Set rngI = usedR.Resize(usedR.Rows.Count - 1).Offset(5).Columns("I:I").SpecialCells(xlCellTypeVisible). Checked with debug.print the result which shows me the end as wrong...$I$174:$I$1046999...proper has to be $I$174:$I$197...what could be the reason behind?
Another question using lastrow calculation..on this way this doesnt work, Dim lastrow As Long, lastrow = rngD(Rows.Count, 1).End(xlUp).row I have to correct like this to count...lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row. What's the reason behind that once working on first way, once only if I double type range. This code is in Personal folder if it counts anyway
Sub Macro2()
Dim wbD As Workbook: Set wbD = Workbooks("dashboard-advanced.xls")
Dim wsD As Worksheet: Set wsD = wbD.Sheets("Sheet1")
Dim rngD As Range: Set rngD = wsD.Range("A:C")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("CALL_REPORT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
rngCallLCL.autofilter Field:=10, Criteria1:=Blanks
Dim lastrow As Long
lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row
Dim usedR As Range, rngI As Range, A As Range, C As Range
Set usedR = wsCallLCL.UsedRange
Set rngI = usedR.Resize(usedR.Rows.Count - 5).Offset(1).Columns("I:I").SpecialCells(xlCellTypeVisible)
For Each A In rngI.Areas
For Each C In A.Cells
res = Application.Match(C.Value, wsD.Range("A2:" & "A" & lastrow), 0)
If IsError(res) Then
C.Offset(, 1).Value = ""
Else
C.Offset(, 1).Value = Application.WorksheetFunction.Index(wsD.Range("B2:" & "B" & lastrow), res, 0)
End If
Next C
Next A
End Sub
Related
I have two excel files, where I need to pull the data from one excel file to another with vlookup function through VBA
.
I placed the below code and tried to make it dynamic
The first piece of code is as under,
Sub Lookup()
' Identifying first and last row
Const wsName As String = "TB"
Const hTitle As String = "India"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim hCell As Range
Set hCell = ws.Cells.Find(hTitle, , xlFormulas, xlWhole, xlByRows)
If hCell Is Nothing Then Exit Sub ' header not found
Dim Col As Long: Col = hCell.Column
Dim fRow As Long: fRow = hCell.Row
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
Debug.Print (fRow)
Debug.Print (lRow)
The above code helps me find "India" in column A, and its First row and last row are identified. As it will be range for me to place vlookup in the next step.
To place vlookup from a different excel file, I used the below code
'Placing vlookup
Dim rw As Long, x As Range
Dim extwbk As Workbook, twb As Workbook
Set twb = ThisWorkbook
Set extwbk = Workbooks.Open("D:\TB_1.xlsx")
Set x = extwbk.Worksheets("SAP TB").Range("B6:I1048576")
With twb.Sheets("TBs - Macros")
For rw = fRow To lRow
.Cells(rw, 10) = Application.Vlookup(.Cells(fRow, 2).Value2, x, 7, 0)
Next rw
End With
extwbk.Close savechanges:=False
End Sub
The above code accurately picks the first Vlookup value and pastes the same to the entire column range, I think I have erred in placing a loop, due to which only the first value is copied and pasted to the entire range. (as shown in the below snapshot)
It can be seen that 155 is correctly picked in formula, however the same is pasted across entire column.
Sample data is shared in the below link.
https://drive.google.com/drive/folders/1inrofeT6v9P0ISEcmbswvpxMMCq5TaV0?usp=sharing
Help would be much appreciated!!!
You do not need any iteration in that code area. VLookup function is able to return an array if its arguments are ranges with more rows. Please replace this part:
With twb.Sheets("TBs - Macros")
For rw = fRow To lRow
.Cells(rw, 10) = Application.Vlookup(.Cells(fRow, 2).Value2, x, 7, 0)
Next rw
End With
with this one:
Dim wsM As Worksheet, rngVLk As Range, rngB As Range
Set wsM = Twb.Sheets("TBs - Macros")
Set rngVLk = wsM.Range("J" & fRow, "J" & lRow)
Set rngB = wsM.Range("B" & fRow, "B" & lRow)
rngVLk.value = Application.VLookup(rngB, x, 7, False)
To avoid problems of the type you faced, please write Option Explicit on top of the module. This will not let you running a piece of code if a used variable has not previously declared and will show/select it.
The problem is in the loop:
With twb.Sheets("TBs - Macros")
For rw = fRow To lRow
.Cells(rw, 10) = Application.Vlookup(.Cells(fRow, 2).Value2, x, 7, 0)
Next rw
End With
You are moving the variable "rw" from "fRow" to "lRow" but you are never using rw.
I think your code should be:
With twb.Sheets("TBs - Macros")
For rw = fRow To lRow
.Cells(rw, 10) = Application.Vlookup(.Cells(rw, 2).Value2, x, 7, 0)
Next rw
End With
How do I get the position of the last non-empty cell in a filtered column without dropping the applied Autofilter? I understand it's easy to get the number of the last visible row with
Dim ws as Worksheet, rng As Range
Set rng = Range(Letter & 1 & ":" & Letter & 1) ' where Letter is the letter code of the column
GetLastVisibleRow = ws.Range(Split(ws.Cells(, rng.Column).Address, "$")(1) & ws.Rows.count).End(xlUp).row
but I need the number of the last filled row instead. At the same time, I'd like to avoid setting
ws.AutoFilterMode = False
if it's possible.
Thanks in advance.
Probably not the most efficient or fastest method, but this appears to work:
Function GetLastCellOfColumn(ColLetter As String) As Range
Dim Col As Range
Dim Rw As Long
Set Col = Range(ColLetter & ":" & ColLetter)
Set GetLastCellOfColumn = Intersect(ActiveSheet.UsedRange, Col)
For Rw = GetLastCellOfColumn.Cells.Count To 1 Step -1
If Len(GetLastCellOfColumn.Cells(Rw).Value) > 0 Then
Set GetLastCellOfColumn = GetLastCellOfColumn.Cells(Rw)
Exit Function
End If
Next
End Function
A charming solution by #jkpieterse plus a useful comment by #BigBen is exactly what I was looking for. Just to finalize the thread, the function returning the row number is
Function GetLastFilledCellOfColumn(ws As Worksheet, ColLetter As String) As Long
Dim Col As Range, Urng As Range, Rw As Long
Set Col = ws.Range(ColLetter & ":" & ColLetter)
Set Urng = Intersect(ws.UsedRange, Col)
For Rw = Urng.Cells.count To 1 Step -1
If Not IsEmpty(Urng.Cells(Rw)) Then
GetLastFilledCellOfColumn = Rw
Exit Function
End If
Next
End Function
Problem solved.
So maybe this is an alternative way to look into:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("_FilterDatabase").Columns(col)
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I'm afraid I rushed this a little and might have made a mistake but will have to get going. Hopefully you understand whats going on =)
Edit:
The above would definately work, but as figured out through the chat, there is actually a ListObject involved, called Table1, which throws of the AutoFilter range. So here are two alternative ways of doing the same thing:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("Table1")
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
Or, when you don't know the name of the table:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .ListObjects(1).Range
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I'm a bit surprised this has proven to be such a challenge. On sheet 1 I have the input which looks as follows:
Private Sub CommandButton1_Click()
erw = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count + 1
'erw.Offset(1).EntireRow.Insert Shift:=xlDow
If Len(Range("c3")) <> 0 Then
Sheet2.Cells(erw, 1) = Range("c3")
Sheet2.Cells(erw, 2) = Range("c4")
Sheet2.Cells(erw, 3) = Range("c5")
Range("c3") = ""
Range("c4") = ""
Range("c5") = ""
Else
MsgBox "You must enter an amount"
End If
End Sub
No issues with the above, where I'm running into a problems is with the following on sheet 2 where the information is stored:
Sub AddUp()
Dim rngcount As Long
Dim TotalA As Long
Dim rng2 As Range
rngcount = Cells(Rows.Count, "A").End(xlUp).Row
Set rng2 = Range("A28")
TotalA = Application.WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet2").Range("a1:a" & rngcount))
rng2 = TotalA
The real issue is the following Set rng2 = Range("A28") as this is essentially a cheat I've been using. I know that there will not be more than 26 entries to be summed and then a new sheet will be started. I currently have the TotalA amount Set to be put in A28, but what I am trying to do is have the TotalA cell move down as more entries are put in. Put another way I would rather the range where TotalA will be able to move as more entries are put in.
I began with the following erw.Offset(1).EntireRow.Insert Shift:=xlDowbut I moved away from that as the insertion of a row needs to occur on sheet2I've left it here for this posting in case there is any valuable feed back.
What I've been focusing on instead is trying to use CurrentRegion.offset(1) to keep moving the cell that holds the sum function down. Problem is I cannot figure out how to declare a range based on rngcount This may be the problem because perhaps I should not be using rngcount as it is not an object, but my thinking is/was that I could turn that rngcount into an object and then use CurrentRegion.offset(1) A bit long winded, hope the goal comes through clearly. Thanks
Take a look at this and see if it does what you want.
Sub AddUp()
Dim rngcount As Long
Dim TotalA As Long
Dim rng2 As Range
rngcount = Cells(Rows.Count, "A").End(xlUp).Row
Set rng2 = Cells(rngcount + 1, 1)
TotalA = Application.WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet2").Range("a1:a" & rngcount))
rng2 = TotalA
End Sub
I usually like to put total formulas in the worksheet instead of doing the math in the macro.
Sub AddUp()
Dim rngcount As Long
Dim TotalA As Long
Dim TotalStartRng As Range
Dim TotalEndRng As Range
rngcount = Cells(Rows.Count, "A").End(xlUp).Row
Set TotalStartRng = Cells(1, 1)
Set TotalEndRng = Cells(rngcount, 1)
Cells(rngcount + 1, 1) = "=SUM(" & TotalStartRng.Address & ":" & TotalEndRng.Address & ")"
End Sub
Code works as expected until the last line where I attempt to move values from one range to another at which point I'm getting a "run time error 1004", so must be doing something wrong.
the range "NewRng" does produce the correct string "$A$1883:$R$2105" which if entered manually into the last line (replacing the "NewRng" reference) it produces the correct results.
Thanks in advance
Dim NevwebLR As String
With Sheets("NevWeb file")
NevwebLR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim DropShipLR As String
With Sheets("Drop Shipments")
DropShipLR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim NevwebLR1 As String
NevwebLR1 = NevwebLR + 1
Dim dropshipglue As Long
dropshipglue = Val(NevwebLR) + Val(DropShipLR)
Dim rng1 As Range, rng2 As Range
Dim NewRng As Range
With ThisWorkbook.Sheets("Results")
Set rng1 = .Range("A" & NevwebLR1)
Set rng2 = .Range("R" & dropshipglue)
Set NewRng = .Range(rng1, rng2)
Debug.Print NewRng.Address
End With
Sheets("results").Range(NewRng).Value = Sheets("Drop Shipments").Range("A1:R" & DropShipLR).Value
You have your destination range already as Range-object, so change the last line to
NewRng.Value = Sheets("Drop Shipments").Range("A1:R" & DropShipLR).Value
I am trying to check whether the values in workbook1-sheet1-A are matched in workbook2-sheet2-E. If there is a match workbook1-sheet1-Y receives a 'x'.
This is the code I have so far and gives me Run time error 424 - Object required error on the if loop.
Sub Check()
'
Application.ScreenUpdating = False
endRow = Range("A" & Rows.Count).End(xlUp).Row
wkbSLA = ("F:\Workbook2")
For i = 2 To endRow
If Cells(i, 1).Value = wkbSLA.Sheets("Sheet2").Range("E2:E575").Value Then
Range("Y" & i) = "x"
End If
Next i
'
End Sub
To ensure your code is doing everything you expect it to it, make sure you qualify your objects with variables.
Also, you cannot use the .Value property on multi-cell range. That is probably where your error is hitting. A better way to approach this is with the .Find method.
If you write the code something like this, it should work for you ... though you may need to tweak it a bit to meet your needs.
Option Explicit
Sub Check()
Application.ScreenUpdating = False
Dim wkb1 as Workbook, wkb2 as workbook
Set wkb1 = Workbooks("workbook1")
Set wkb2 = Workbooks("F:\Workbook2")
' -> do you need Workbooks.Open("F:\Workbook2") here?
' Seems you may if the workbook you want to access is closed
Dim wks1 as Worksheet, wks2 as Worksheet
Set wks1 = wkb1.Sheets(1) 'may need to change this reference for your needs
Set wks2 = wkb2.Sheets("Sheet2")
With wks1
Dim endRow as Long
endRow = .Range("A" & Rows.Count).End(xlUp).Row
Dim i as Long
For i = 2 To endRow
Dim rng as Range
Set rng = wks2.Range("E2:E575").Find .Cells(i,1).Value lookat:=xlWhole
If Not rng Is Nothing Then .Range("Y" & i) = "x"
Next i
End With
End Sub