I am trying to loop through the rows in my sheet, adding cells B-F of the current row to a range to be copied to another sheet. The cells in the row (B-F) should only be added to the range if the value in column G is "Active" and if the value in column C has a value (not empty/nothing/null/!#VALUE...)
I've tried several ways around it, but I keep getting 1004: App/Object defined error off the first If statement
The msgbox shows me the range is valid, I've tried qualifying to the tiniest detail and also using Cells() instead of .range to no avail.
MsgBox (ActiveWorkbook.Worksheets("Staging").range("G" & Cells(rows.Count, 5).End(xlUp).Row).Value)
For i = Cells(rows.Count, 5).End(xlUp).Row To i = 1 Step -1
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
If Not IsError(ActiveWorkbook.Worksheets("Staging").range("C" & i)) Then
Set selectRange = range("B" & i & ":F" & i)
Set copyRange = Union2(copyRange, selectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
Am I just missing something simple here? I've been banging my head over this for hours now.
...and for you eagle eyes out there, Union2 isn't a typo, just a user defined function to avoid not being able to join ranges set to "Nothing"
Try the following:
Change the second line to
For i = Cells(rows.Count, 5).End(xlUp).Row To 1 Step -1
Change the third line to
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
To start change:
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
To
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
Or
If ActiveWorkbook.Worksheets("Staging").Cells(i , 7).Value = "Active" Then
You also need to fully qualify all your ranges as alot of your ranges are pointing to the active sheet and NOT "staging" Unless it is the active sheet, but just to be sure you should use the following code:
With ActiveWorkbook.Worksheets("Staging")
MsgBox (.Range("G" & .Cells(.Rows.Count, 5).End(xlUp).Row).Value)
For i = .Cells(.Rows.Count, 5).End(xlUp).Row To 1 Step -1
If .Range("G" & i).Value = "Active" Then
If Not IsError(.Range("C" & i)) Then
Set SelectRange = .Range("B" & i & ":F" & i)
Set copyRange = Union(copyRange, SelectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
End With
Also You are using copyRange in this scope without it being declared, I am assuming you are assigning it to a range earlier in your code but if not please make sure to do that.
This is wrong:
ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value
You can use these:
ActiveWorkbook.Worksheets("Staging").Cells(i, 6)
ActiveWorkbook.Worksheets("Staging").range(cells(i, 6), cells(i, 6)).value
ActiveWorkbook.Worksheets("Staging").range("G" + strings.trim(str(i))).value
I was getting the below Error:
Go to Home -> Select the cell for which you are getting Error-> Use clear all funtion to clear the method.
I executed the script again and it started working fine.
Related
I am having a fair amount of trouble with the code below:
Sub TestEmail()
Dim i As Long
Dim LastRow As Long
Dim a As Worksheet
Dim b As Worksheet
Dim strText
Dim ObjData As New MSForms.DataObject
Set a = Workbooks("Book2").Worksheets(1)
Set b = Workbooks("Book1").Worksheets(1)
LastRow = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Not IsError(Application.Match(a.Cells(i, 7).Value, b.Columns(3), 0)) And IsError(Application.Match(a.Cells(i, 4).Value, b.Columns(11), 0)) Then
a.Range("D" & i).Copy
ObjData.GetFromClipboard
strText = Replace(ObjData.GetText(), Chr(10), "")
b.Range("K" & ).Value = b.Range("K" & ).Value & " / " & strText
End If
Next i
End Sub
I face two problems, one has me stumped and the other is due to lack of knowledge:
The line after IF is supposed to check if two values (numbers) in both workbooks match, and if two other values (text) don't match. If all true, then it must copy a value from Book2 and add it to a cell in book1.
The problems are:
-The macro doesn't seem to recognise when the values match or not.
-In the last line before "End If", I don't know how to tell excel to copy the text into the cell that didn't match in the second check.
I am sorry if I am not clear enough, this is hard to explain.
I'm hoping one of the experts knows how to make this work.
Thanks in advance
You are using If Not condition 1 And condition 2, so you are saying that if it doesn't match both conditions, Then you run the code. What you want to make are Nested If Statements However, one is If and the other If Not
To copy you are missing the i After "K"&: b.Range("K" & i) = b.Range("K" & i).Value & " / " & strText
The Address of the Cells are inside the Range Function, which in your case would be:
//It is the cell of the email from the first Workbook tou are copying, where you input the column D
a.Range("D" & i).Copy
//Add to Workbook b in column K the value from Cell K#/value copied
b.Range("K" & i) = b.Range("K" & i).Value & " / " & strText
You can also make it like this: b.Range("K" & i) = b.Range("K" & i).Value & " / " & a.Range("D" & i)
This way you are matching lines, so only if the IDs are on the same rows on both Workbooks it will work. If they aren't, you will have to use Nesting Loops or .Find Function
EDIT:
If I understood it, the code below might work if you make some changes for your application, because i didn't have the data to test and columns, etc. Try to implement it.
LastRowa = a.Cells(Rows.Count, "A").End(xlUp).Row
LastRowb = b.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRowa
'Address of String to look for
LookForString = a.Worksheets(1).Cells(i, 4) '4 is the COLUMN_INDEX
'Range to look on Workbook a
With a.Worksheets(1).Range("D1:D" & LastRowa) 'choose column to look
'Function .Find String on book a
Set mail_a = .Find(LookForString, LookIn:=xlValues)
If Not mail_a Is Nothing Then
FirstAddress = mail_a.Address
Do ' Actions here
'Range to look on Workbook b
With b.Worksheets(1).Range("K1:K" & LastRowb) 'choose column to look
'Function .Find on Workbook b
Set mail_b = .Find(LookForString, LookIn:=xlValues)
If Not mail_b Is Nothing Then
FirstAddress = mail_b.Address
Do 'Actions
'Verify if two other values (text) don't match
If Not WRITE_MATCH_CONDITION_HERE Then
'No need to verify of they are equal because the .Find function used the same reference
'I will use .Cells with .Row and .Column just to show another way to do it and make it dynamic
b.Cells(mail_b.Adress.Row, mail_b.Adress.Column) = b.Cells(mail_b.Adress.Row, mail_b.Adress.Column).Value & " / " & a.Cells(mail_a.Adress.Row, mail_a.Adress.Column) 'choose columns
End If
Set mail_b = .FindNext(mail_b)
Loop While Not mail_b Is Nothing And mail_b.Address <> FirstAddress
End If
End With
Set mail_a = .FindNext(mail_a)
Loop While Not mail_a Is Nothing And mail_a.Address <> FirstAddress
End If
End With
Next i
End Sub
p.s.: The <> is missing on mail_a.Address <> FirstAddress and mail_b.Address <> FirstAddress, when i posted with
The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub
I'm currently trying to use VBA to copy some cells from one location to another and because I'm new to VBA I was wondering if anyone could help me make my code a bit more efficient I know there must be a way to copy to a cell without having to select the cell and then copy to it
For i = 1 To dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Row
dataSheet.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = dataSheet.Range("C" & i)
pasteSheet.Activate
If rCell = condition1 Then
With ActiveSheet
.Range("CU" & rowLoop2).Select
ActiveSheet.paste
End With
You have 2 options. Either use the .PasteSpecial method, or you can just reference the original range and set the new range to it's value.
.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
With the setting values option, you have to define the whole range which the values should fill.
Range("A3:E3").Value = Range("A1:E1").Value
If you just used Range("A3").Value = Range("A1:E1").Value only cell A3 would be populated, and it would take th value from cell A1. Hope this helps.
Edit: it's worth noting that you do not have to change sheets to paste either. Your code could be amended to the below:
With dataSheet
For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = .Range("C" & i)
If rCell = condition1 Then
pasteSheet.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
End If
Next i
End With
I have a sheet with multiple data in 1 cell this happen in a couple of columns. What I need to do is split the cell into individual rows while still keep the details from the other columns
Screen 1 shows the data i got
http://imageshack.com/a/img845/1783/wxc8.png (Screen 1)
Screen 2 is what i wish the macro to output.
http://imageshack.com/a/img842/7356/7yra.png (screen 2)
The macro i found and edited in only allows me to split 1 column and i can't get the editing of the range right. the columns that needs to be split is "J" "K" "N" and "O". The columns "A"- "I" and "L""M" just needs to copy their content to the new row.
Thank you in advance for the help.
Here the Macro im using
Sub Splt1()
Dim LR As Long, i As Long
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("J" & Rows.Count).End(xlUp).Row
Columns("J").Insert
For i = LR To 1 Step -1
With Range("K" & i)
If InStr(.Value, Chr(10)) = 0 Then
.Offset(, -1).Value = .Value
Else
X = Split(.Value, Chr(10))
.Offset(1).Resize(UBound(X)).EntireRow.Insert
.Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End If
End With
Next i
Columns("K").Delete
LR = Range("J" & Rows.Count).End(xlUp).Row
With Range("L1:M" & LR)
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
On Error GoTo 0
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub
The problem appears to be the with operator. It constrains your selection. Try reformulating your macro without the with and refer to the the ranges direct. For example, replace your first for loop with something like this:
For i = LR To 1 Step -1
If InStr(Range("K" & i).Value, Chr(10)) = 0 Then
Range("K" & i).Offset(, -1).Value = Range("K" & i).Value
'Range("J" ...
'Range("N" ...
'Range("O" ...
Else
K_collection = Split(Range("K" & i).Value, Chr(10))
Range("K" & i).Offset(1).Resize(UBound(K_collection)).EntireRow.Insert
Range("K" & i).Offset(, -1).Resize(UBound(K_collection) - LBound(K_collection) + 1).Value = Application.Transpose(K_collection)
'J_collection = Split(Range("J"...
'N_collection = Split(Range("N"...
'O_collection = Split(Range("O"...
End If
Next i
In general I avoid with because it tends to obscure the visual pattern of code.
You might also consider eliminating the .INSERT and .DELETE columns, and overwrite directly to the cells. When working with more than one at a time, it becomes hard to keep track which column is temporary and which one is the source. But that all depends on your preference.
Copying values for the other columns should be easy compared to this.
So yesterday I posted my first SO question, and it went down like a ton of bricks. However I've picked myself up, dusted myself off, and hopefully this question will be more acceptable... :-)
I am trying to remove data duplicates from a list of Health Questionnaires I have to monitor, but the tricky bit I was struggling with was finding a duplicate in one column, AND then checking that the data on the same row, for the 3 adjacent columns were also duplicates. Storing the searched for 'duplicated row' was the bit that was throwing me off.
Here's some code I've cobbled together from other similarly-functioning scripts. I'm now in debug mode and keep getting errors thrown up... I don't have much experience of VBA, so i'm running out of options.
I'm currently getting type mismatch errors with the variable g, and also firstAddress. Why are these causing problems???
Can I call firstAddress.Row or am I barking up the wrong tree?
Here's the snippet:
g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
And here's the whole code below. Any help would be much appreciated!
Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Integer
Dim firstAddress As Integer
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range
'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)
Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lw 'Find duplicates from the list.
If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
With Worksheets("Still In Progress").rngFirst
g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
If Range("H" & dupRow).Text = Range("H" & i).Text _
And Range("I" & dupRow).Text = Range("I" & i).Text _
And Range("J" & dupRow).Text = Range("J" & i).Text Then
'select the entire row
Range.EntireRow.Select
'copy the selection
Selection.Cut
'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Completed")
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
'delete the initial row
rngCell.EntireRow.Delete
Set g = .FindNext(g)
Loop While Not g Is Nothing And g.Address <> firstAddress
End If
End With
Next i
End Sub
I went through your code carefully. There were a number of problems. Some of these I think I was able to fix - there was one where I guessed what you intended to do, but for one of them I just marked it; you need to explain what you were trying to do, as you are deleting a range that you never defined...
The first problem is with the line:
If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
The CountIf function returns a number; you are comparing this number with the string "Complete". I don't think you can ever get past this line, so the rest of the code (whether correct or not) will not execute. Not entirely clear what you are trying to do in this line, as I'm not sure when a line will be marked "Complete" - but assuming that you are interested in executing the rest of the code if the cell in A & i has the string "Complete" in it, then you probably want to do
If Range("A" & i).Text = "Complete" Then
There were a number of If - Then, With, and Loop structures that were not properly terminated with a matching End. I have tried to remedy this - make sure I did it right. Note that using proper indentation really helps to find problems like this. The space bar is your friend...
Since the Find method returns an object, the correct way to use the function is
Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
Apart from that - use Option Explicit at the top of your code, and define variables with the most restrictive (correct) type that you can. When I did this I found the error I could not correct - with the rngCell variable that was neither declared, nor ever set... It shows just how helpful it can be. Also good for catching typos - VBA will happily let you write things like
myVar = 1
MsgBox myVra + 1
The message will be 1, not 2, because of the typo... The fact that Explicit should even be an option is one of the many inexplicable design decisions made by the VBA team.
Here is your code "with most of the errors fixed". At least like this it will compile - but you must figure out what to do with the remaining error (and I can't be sure I guessed right about what you wanted to do with the cell marked "Complete").
Comments welcome.
Option Explicit
Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Range
Dim firstAddress As Range
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range
'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)
Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lw 'Find duplicates from the list.
' If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
If Range("A" & i).Text = "Complete" Then
'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
With Worksheets("Still In Progress").rngFirst
Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
If Range("H" & dupRow).Text = Range("H" & i).Text _
And Range("I" & dupRow).Text = Range("I" & i).Text _
And Range("J" & dupRow).Text = Range("J" & i).Text Then
'select the entire row
g.EntireRow.Select
'copy the selection
Selection.Cut
'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Completed")
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
'delete the initial row
rngCell.EntireRow.Delete ' <<<<<< the variable rngCell was never defined. Cannot guess what you wanted to do here!
Do
Set g = .FindNext(g)
Loop While Not g Is Nothing And g.Address <> firstAddress
End If ' entire row matched
End If ' Not g Is Nothing
End With ' With Worksheets("Still in Progress")
End If ' CountIf = "Complete"
Next i
End Sub
Another handy trick: when you "paste in the next available row" as you are doing with Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select, I usually find it handy to do something like this instead:
Dim destination As Range
Set destination = Worksheets("Sheetname").Range("A1")
And when you need to paste something:
destination.Select
ActiveSheet.Paste
Set destination = destination.Offset(1,0)
This way, destination is always pointing to the "next place where I can paste". I find it helpful and cleaner.