I am trying to copy the entire range from "Leads" sheet after the last row of "TempDataNew"
If Sheets("Leads").Range("A1") <> "" Then
Set rngSource = Sheets("Leads").Range("A1").CurrentRegion
lastrowdyn = rngSource.Rows.Count
If lastrowdyn > 0 Then
Sheets("Leads").Range("A:A").Copy
Sheets("TempDataNew").Range ("A" & x)
Set rngSource = Sheets("TempDataNew").Range("A1").CurrentRegion
x = lastrowdyn + 1
End If
End If
I am getting the "Application Defined or Object Defined Error" when the code is trying to paste. Any thoughts?
From what I can tell, you want to copy to the bottom of the used range of TempDataNew, not Leads. So change this
Set rngSource = Sheets("Leads").Range("A1").CurrentRegion
to this
Set rngSourceTempDatNew = Sheets("TempDatNew").Range("A1").CurrentRegion
lastrowdynTempDatNew = rngSourceTempDatNew.Rows.Count
Also, I'm guessing you really don't want or need to copy the entire column A of Leads. So this needs to be changed.
Sheets("Leads").Range("A:A").Copy
or that is exactly what you'll end up doing. May I recommend also finding the last row of the used range in column A of Leads as you want to do for TempDatNew. Maybe something like
Set rngSourceLeads = Sheets("Leads").Range("A1").CurrentRegion
Now just copying from the range in Leads to the right spot in TempDatNew can be done with something like this
rngSourceLeads.Copy _
destination:=Worksheets("TempDatNew").Range("A" & lastrowdynTempDatNew + 1)
I can't exactly tell why you are storing the last row plus one to x, but my current thinking is that it isn't needed for your purposes. Every time this code is ran, it will update the last row of TempDatNew for you and you just simply paste in the row after that.
So, all together you have something more succinct and accurate with
If Sheets("Leads").Range("A1") <> "" Then
Set rngSourceTempDatNew = Sheets("TempDatNew").Range("A1").CurrentRegion
lastrowdynTempDatNew = rngSourceTempDatNew.Rows.Count
Set rngSourceLeads = Sheets("Leads").Range("A1").CurrentRegion
rngSourceLeads.Copy destination:=Worksheets("TempDatNew").Range("A" & lastrowdynTempDatNew + 1)
End If
EDIT
If you only want to copy column A in "Leads" change this
Set rngSourceLeads = Sheets("Leads").Range("A1").CurrentRegion
to this
lastrowdynLeads = Sheets("Leads").Cells(65000, 1).End(xlup).Row
Set rngSourceLeads = Sheets("Leads").Range("A1:A" & lastrowdynLeads)
This assumes you have no data below row 65000 in column A in sheet "Leads".
You have not specified what x is before you begin running the code. I have added a line to give x a value. The way you had it, excel was evaluating x to be 0, thus resulting in a range called Range("A0")... that doesn't exist.
If Sheets("Leads").Range("A1") <> "" Then
Set rngSource = Sheets("Leads").Range("A1").CurrentRegion
lastrowdyn = rngSource.Rows.Count
x = 1 'Whatever integer it is supposed to start at
If lastrowdyn > 0 Then
Sheets("Leads").Range("A:A").Copy
Sheets("TempDataNew").Range ("A" & x)
Set rngSource = Sheets("TempDataNew").Range("A1").CurrentRegion
x = lastrowdyn + 1
End If
End If
I think I found the problem you were originally experiencing in your code... Your first IF statement says If Sheets("Leads").Range("A1") <> "" Then. Your referencing a range object, and comparing it to a value. Your error should go away if you use Sheets("Leads").Range("A1").Value <> "".
I'm not sure why you want to use .CurrentRegion if you're only working with a single column (I'm also not the most versed in VBA logic) but if you're just trying to find the last row, you could use something like this:
Dim Leads, TempDataNew as Worksheet
Set Leads = ThisWorkbook.Sheets("Leads")
Set TempDataNew = ThisWorkbook.Sheets("TempDataNew")
lastrowdyn = Leads.Cells(Leads.Rows.Count, "A").End(xlUp).Row
If Leads.Range("A1").Value <> "" And lastrowdyn > 0 Then
Leads.Range("A:A").Copy Destination:=TempDataNew.Range("A" & x)
x = lastrowdyn + 1
End If
Why not just this?
Sub CopyRange()
Dim wsLeads As Worksheet, wsTemp As Worksheet
Dim lLastRowNew As Long, lRows As Long, iColumns As Integer
Set wsLeads = Worksheets("Leads")
Set wsTemp = Worksheets("TempDataNew")
lLastRowNew = wsTemp.UsedRange.Rows(wsTemp.UsedRange.Rows.Count).Row
lRows = wsLeads.UsedRange.Rows.Count
iColumns = wsLeads.UsedRange.Columns.Count
If wsLeads.Range("A1").Value <> "" And lRows > 0 Then
wsTemp.Cells(lLastRowNew + 1, 1).Resize(lRows, iColumns).Value = wsLeads.UsedRange.Value
End If
End Sub
Related
I'm trying to check two sets of information in two different tabs, and then get all the records into a third tab, highlighting discrepancies in the information and also records that are present in a set but not the other. As an added difficulty, the information that I need to check is not written exactly in the same way in both tabs. Eg: in one of the tabs products are called "Product 1, Product 2", etc, whereas the other uses just the numbers.
I'm pretty new to VBA, and my best idea so far is selecting a column with IDs in one of the sets and using Find to check the other set for matches. After that I'd like to use Offset on the value Find returns to check the other cells in the row.
However, I'm encountering and 'Object variable or With block variable not set' error and I don't know what I'm doing wrong.
Below is the code, I'd really appreciate any help with using Offset in this scenario (or ideas on a more efficient way to get the results).
Sub Test()
Dim Candi_ID As String
Dim Full_Name As String
Dim i_Row As Object
Dim i_Cell As Range
Dim MD_Range As Integer
Dim i_Cell As Range
Sheets("M Report").Select
MD_Range = Application.WorksheetFunction.CountA(Range("C:C")) 'column with the IDs
For R = 2 To MD_Range
Candi_ID = Sheets("M Report").Cells(R, 3)
Full_Name = Sheets("M Report").Cells(R, 1)
If Candi_ID <> "" Then
With Sheets("i Report").Range("B:B")
Set i_Cell = .Find(What:="*" & Candi_ID, LookIn:=xlValues)
If i_Cell Is Nothing Then
Sheets("Tracker").Range("A" & Last_Row + 1) = Candi_ID
Sheets("Tracker").Range("A" & Last_Row + 1).Interior.Color = RGB(255, 0, 0)
Else
Last_Row = Sheets("Tracker").Cells(.Rows.Count, "A").End(xlUp).Row
Sheets("Tracker").Range("A" & Last_Row + 1) = Candi_ID
End If
If Full_Name <> "" Then
If Full_Name = i_Cell.Offset(0, -1) Then 'full name is one cell to the left of the ID cell
Sheets("Tracker").Range("C" & Last_Row + 1) = Full_Name
Else
Sheets("Tracker").Range("C" & Last_Row + 1) = Full_Name
Sheets("Tracker").Range("C" & Last_Row + 1).Interior.Color = RGB(255, 0, 0)
End If
End If
End With
End If
Last_Row = Last_Row + 1
Next R
End Sub
You need another test in case i_Cell was not set on this line:
Set i_Cell = .Find(What:="*" & Candi_ID, LookIn:=xlValues)
Something like:
If Full_Name <> vbNullString And Not i_Cell Is Nothing Then
If it is Nothing, and you don't test for this further down, you will get the error you mention.
Also, you have a duplicate declaration, some missing declarations, and use Long rather than Integer. Put Option Explicit at the top of all your modules. Avoid .Select, which slows your code, and use With statements where possible.
I replaced the empty literal string "" with vbNullString.
I am trying to copy data from one sheet as long as the meet the twp below criteria. However, not all the data is being transferred. Any thing stand out to anyone as wrong in my code?
Private Sub FIlist()
Dim LastRow As Long, fgLastRow As Long
Dim c As Integer
LastRow = ActiveWorkbook.Sheets("DaysReport").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
Call StartCode
With ActiveWorkbook
For c = 1 To LastRow
If .Sheets("DaysReport").Range("B1").Offset(c - 1, 0) = "ACCEPT" And .Sheets("DaysReport").Range("C1").Offset(c - 1, 0) = "ST" Then
fgLastRow = ActiveWorkbook.Sheets("FG LIST").Range("A1000000").End(xlUp).Row
fgLastRow = fgLastRow + 1
.Sheets("FG LIST").Range("A" & fgLastRow) = .Sheets("DaysReport").Range("A2").Offset(c - 1, 0)
End If
c = c + 1
Next c
End With
Call EndCode
End Sub
The first thing that jumps out is that c should be Long as well.
The use of ActiveWorkbook may be a deliberate design choice - but if it always runs from this workbook, then use ThisWorkbook. Your user could change the workbook or active window at any time, thus causing chaos and mayhem (or at least unknown or undefined results).
Don't use Call - this is now deprecated. Not a show stopper, but still a bad habit.
Watch your index offsets, they can be confusing. Instead of c-1 all the time, just set your start parameters earlier. This means that we remove a +1 in a couple of spots as well!
Now that I tidied the code up - I saw the biggie. And the cause of your problems. I have left it commented in the code below. You are in a loop, and you also increment c (c = c + 1). This means that you skip every second row. If you really want to skip every second row then use For c = 0 To LastRow Step 2 because it is clearer code and your intention is obvious.
Private Sub FIlist()
Dim LastRow As Long, fgLastRow As Long
Dim c As Integer
StartCode
With ThisWorkbook.Sheets("DaysReport")
LastRow = .Range("A1000000").End(xlUp).Row
For c = 0 To LastRow
If .Range("B1").Offset(c, 0) = "ACCEPT" And .Range("C1").Offset(c, 0) = "ST" Then
fgLastRow = ThisWorkbook.Sheets("FG LIST").Range("A1000000").End(xlUp).Row + 1
ThisWorkbook.Sheets("FG LIST").Range("A" & fgLastRow) = .Range("A2").Offset(c, 0)
End If
'c = c + 1
Next c
End With
EndCode
End Sub
You must get rid of that
c = c + 1
Which is making your loop variable update by steps of two !
Furthermore you may want to adopt the following refactoring of your code:
Private Sub FIlist()
Dim cell As Range
Dim fgSht As Worksheet
Set fgSht = ActiveWorkbook.Sheets("FG LIST")
StartCode
With ActiveWorkbook.Sheets("DaysReport")
For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
If cell.Offset(,1).Value = "ACCEPT" And cell.Offset(,2).Value = "ST" Then fgSht.Cells(fgSht.Rows.Count, 1).End(xlUp).Offset(1).Value = cell.Offset(1).Value
Next
End With
EndCode
End Sub
Please note that I wrote:
If cell.Offset(,1).Value = "ACCEPT" And cell.Offset(,2).Value = "ST" Then fgSht.Cells(fgSht.Rows.Count, 1).End(xlUp).Offset(1).Value = cell.Offset(1).Value
To cope with your code that copied the value in column A one row below the current loop row
Should you actually need to copy the value in column A current row, then just remove that last .Offset(1)
I need to run a macro between two worksheets where say column C in "Sheet 1" has a "Y", I need column AP in "Sheet 2" to return something along the lines of "covered" or "Y". Just something to indicate that a Y was there in Sheet 1. I am mainly running issues in actually connecting the two worksheets. This code below works fine if I am running it on columns within the same work sheet.
Code:
Private Sub Set_Border_Pattern(Requirements_Selector_Str As String)
Dim strTemp As String
Dim strRange As String
Dim strCellVal As String
If Len(Requirements_Selector_Str) > 2 Then
strTemp = Mid(Requirements_Selector_Str, 4, 1)
Else
strTemp = Requirements_Selector_Str
End If
With Worksheets("test")
For i = 2 To REQUIREMENT_ROW_COUNT
strRange = strTemp & i
strCellVal = .Range(strRange).Value
If strCellVal = "Y" Then
Worksheets("NFR_List").Range(AP & i).Value = "Y"
End If
Next i
End With
The code below does what you describe in a very simple way. I believe that if you understand it you will be able to modify it for your situation. If not, please feel free to ask questions.
Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range, i As Long
Set sh1 = Worksheets("test")
Set sh2 = Worksheets("NFR_List")
Set r1 = sh1.Range("C1")
Set r2 = sh2.Range("AP1")
i = 0
While r1.Offset(i, 0) <> ""
If r1.Offset(i, 0) = "Y" Then r2.Offset(i, 0) = "Y"
i = i + 1
Wend
End Sub
I've assumed that Column C has no blank cells until the data is finished, but if this is not true, the code can be easily modified according to your needs.
Another approach would be to just use a formula for this (instead of VBA), such as =IF(test!C1="Y", "Y","") in AP1 (if the "NFR_List" sheet) and then drag the formula down. Or you could also put the formula in using VBA using code like, r2.offset(i,0).formula = ... . There are many ways.
I'm trying to create a macro that uses Index/match functions to match and pull data from one sheet into another. I did it in Excel and it works perfect. However the reports are "dynamic" (the size changes) so I need the last row of my code to be dynamic as well.
The following is what I have done. I'm NOW getting a "type mismatch" error (I emphasize "now" since every time I find a solution for one error another pop's up).
Dim prosheet As Worksheet
Dim prosheet2 As Worksheet
Set prosheet2 = ThisWorkbook.Sheets("shipstation")
Set prosheet = ThisWorkbook.Sheets("macrotestfb")
lr1 = prosheet.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = prosheet2.Cells(Rows.Count, 1).End(xlUp).Row
lrship = prosheet.Cells(Rows.Count, 10).End(xlUp).Row
lrindex = prosheet2.Cells(Rows.Column, 14).End(xlUp).Row
'CALCULATE SHIPPING COST
For x = prosheet.range("j6") To lrship
x = Application.WorksheetFunction.Index(prosheet2.range("a1:n" & lrindex), Application.WorksheetFunction.Match(prosheet.range("a6:a" & lr1), prosheet2.range("a1:a" & lr2), 0), prosheet2.range("f2"))
Next x
Match, in its non array form, only likes one value in the first criterion and not a range.
Also WorksheetFunction.Match will throw an error that will stop the code if a match is not found.
I like to pull the match into its own line and test for the error.
I also adjusted your For statement.
There is no detriment to searching an entire column so I got rid of a few of you last row searches as they are not needed.
Dim prosheet As Worksheet
Dim prosheet2 As Worksheet
Dim x As Long
Dim t As Long
Set prosheet2 = ThisWorkbook.Sheets("shipstation")
Set prosheet = ThisWorkbook.Sheets("macrotestfb")
lrship = prosheet.Cells(Rows.Count, 1).End(xlUp).Row
'CALCULATE SHIPPING COST
For x = 6 To lrship
t = 0
On Error Resume Next
t = Application.WorksheetFunction.Match(prosheet.Range("A" & x), prosheet2.Range("A:A"), 0)
On Error GoTo 0
If t > 0 Then
prosheet.Cells(x, "J").Value = prosheet2.Range("F"&t)
Else
prosheet.Cells(x, "J").Value = "Item does not Exist"
End If
Next x
Note:
Instead of an Index/Match combo which you might use on the worksheet, you can use Application.Match in VBA. Something like this:
Sub GetMatch
Dim indexRng As Range, matchRng as Range
Set indexRng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A10")
Set matchRng = ThisWorkbook.Worksheets("Sheet1").Range("B1:B10")
debug.print indexRng.Cells(Application.Match("something",matchRng,0)).Value
End Sub
I have a spreadsheet that is a data-entry tool for pulling equipment tags and line numbers from engineering drawings – it’s set up with a table that takes either 3-segment tags (columns A-C), 5 segment line numbers (columns A-E), or a list of complete tags (column F), with column G either concatenating the tag segments or pulling across the complete tag. I had this set up using a formula, but I’d rather avoid using complicated formulas in anything that anyone else is going to use and so I took a stab at converting the formula to VBA and putting in a Worksheet_Change procedure.
The code works fine... until you make a change to a cell on the last row of the table and then hit enter or use the down arrow key, at which point Excel crashes. Moving sideways or upwards is fine, and so is moving sideways off the changed cell before hitting enter. I tried converting the table to a regular range, and it still crashes at the last row of the data. I tried turning Application.EnableEvents to False, and that stops the crashing, but then the updating no longer triggers properly.
If the procedure is changed to Worksheet_SelectionChange, it doesn’t crash.
Just to make it more interesting, in both the Worksheet_Change and Worksheet_SelectionChange procedures, using the up/down arrow keys or the enter key fails to trigger a change, but in the Worksheet_SelectionChange procedure arrowing back down/up to the row off which I just moved triggers the update.
I’m sure there are a million ways to fix this, but I have no idea how to do it, and I haven’t had any luck finding an answer.
What I want is for the code to update column G whenever the active cell changes – regardless of whether I use the enter key, tab key, arrow keys, or the $!## mouse to change my cell selection.
I'm working on a Windows 10 machine, using Excel 2016. When I get to work tomorrow I'll see how it goes on Excel 2013.
Spreadsheet screencap, for reference: https://drive.google.com/file/d/0B_wa8YmM1J2ddjlkOWxERE5TM1k/view?usp=sharing
Any assistance would be hugely appreciated - especially if it comes with a thorough explanation about what is going on here.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strDelim As String
Dim strConcatTag As String
Dim intActiveRow As Integer
Dim rngTagSegment As Range
Dim rngSingleTag As Range
Dim rng3SegmentTag As Range
Dim rng5SegmentTag As Range
Dim rngTagEntry As Range
Dim rngConcatTag As Range
Dim rngCheck As Range
strDelim = "-"
intActiveRow = ActiveCell.Row
Set rngSingleTag = Cells(intActiveRow, 6)
Set rng3SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 3))
Set rng5SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 5))
Set rngTagEntry = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 6))
Set rngConcatTag = Cells(intActiveRow, 7)
If intActiveRow = 1 Then
Exit Sub
Else
Select Case True
Case WorksheetFunction.CountA(rngTagEntry) = 0
rngConcatTag = ""
Case WorksheetFunction.CountA(rng5SegmentTag) > 0 And WorksheetFunction.CountA(rngSingleTag) > 0
rngConcatTag = "Enter either a complete tag or the individual sections, not both"
Case WorksheetFunction.CountA(rng5SegmentTag) = 0 And WorksheetFunction.CountA(rngSingleTag) <> 0
rngConcatTag = UCase(Trim(rngSingleTag))
Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 3
For Each rngTagSegment In rng5SegmentTag
strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
Next
rngConcatTag = UCase(Trim(strConcatTag))
Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 5
For Each rngTagSegment In rng5SegmentTag
strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
Next
rngConcatTag = UCase(strConcatTag)
Case Else
rngConcatTag = "Incomplete Tag"
End Select
End If
End Sub
Something like this should work:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Range, r As Range, dataRange As Range
Dim rngSingleTag As Range
Dim rng3SegmentTag As Range
Dim rng5SegmentTag As Range
Dim rngTagEntry As Range
Dim rngConcatTag As Range
'data entry area only (adjust to suit)...
Set dataRange = Application.Intersect(Target, Me.Range("A2:F10000"))
If dataRange Is Nothing Then Exit Sub 'nothing to do...
'process each changed row
For Each r In dataRange.Rows
Set rw = r.EntireRow
Set rngSingleTag = rw.Cells(6)
Set rng3SegmentTag = rw.Cells(1).Resize(1, 3)
Set rng5SegmentTag = rw.Cells(1).Resize(1, 5)
Set rngTagEntry = rw.Cells(1).Resize(1, 6)
Set rngConcatTag = rw.Cells(7)
Select Case True
Case filled(rngTagEntry) = 0
rngConcatTag = ""
Case filled(rng5SegmentTag) > 0 And filled(rngSingleTag) = 1
rngConcatTag = "Enter either a complete tag or the individual sections, not both"
Case filled(rng5SegmentTag) = 0 And filled(rngSingleTag) = 1
rngConcatTag = UCase(Trim(rngSingleTag))
Case filled(rng3SegmentTag) = 3 And filled(rng5SegmentTag) = 3
rngConcatTag = Tag(rng3SegmentTag)
Case filled(rng5SegmentTag) = 5
rngConcatTag = Tag(rng5SegmentTag)
Case Else
rngConcatTag = "Incomplete Tag"
End Select
Next r
End Sub
Function filled(rng)
filled = Application.CountA(rng)
End Function
Function Tag(rng) As String
Const DELIM As String = "-"
Dim c As Range, rv As String
For Each c In rng.Cells
rv = rv & IIf(Len(rv) > 0, DELIM, "") & Trim(c.Text)
Next c
Tag = rv
End Function