I have written the below script which will loop through a range of data and copy from one sheet and paste to another, which works fine. I’m now looking to add the workbook name to column D on each row the data is pasted yet all attempts fail.
This is what I’m trying, please help.
For i = 6 To LastRow
If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy
erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
Worksheets("iForms").Cells(1, 5).Value = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
If Cells(i, 22) <> "" Then Cells(i, 23).Value = Time
If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
ActiveWorkbook.Save
End If
Next i
Related
Please I have an issue, everytime a change occcurs on the sheet it affects all the rows instead of the row (i) concerned. Confused. Don't for-loops work for worksheet_change ? Pls help. Thanks.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
'create a variable for last row of column C, LR
LR = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To LR
If Cells(i, 6) = "Yes" And Cells(i, 7).Value = "Full" Then
Target.Value = Cells(i, 3).Value
Cells(i, 9).ClearContents
Cells(i, 10).Value = Cells(i, 8).Value + Cells(i, 9).Value
End If
If Not Intersect(Target, Range("G" & i & ":G" & LR)) Is Nothing And Range("F" & i) = "Yes"
And Target.Value = "Full" Then
Application.EnableEvents = False
Cells(i, 8).Value = Cells(i, 3).Value
Cells(i, 9).ClearContents
Cells(i, 10).Value = Cells(i, 8).Value + Cells(i, 9).Value
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("G" & i & ":G" & LR)) Is Nothing And Range("F" & i) = "Yes" And
Target.Value = "Portion" Then
Application.EnableEvents = False
Cells(i, 8).Value = Cells(i, 3).Value
Cells(i, 10).Value = Cells(i, 8).Value + Cells(i, 9).Value
Application.EnableEvents = True
End If
Next i
End Sub
It seems you need to launch this event for the columns A-E. So, you can start your macro with:
IF Target.Column <= 5 THEN
...
END IF 'at the end of your macro
Like this, when you launch code like Cells(i, 8).Value = ..., Cells(i, 10).Value = ..., ... this macro will be called but it will be stopped immediately.
Apparently you are checking on column, maximum 10, which is in the range of the cells you are changing within your macro. Let's go for another approach:
At the very beginning of your macro, put this line:
Application.EnableEvents = False
At the very end of your macro, put this line:
Application.EnableEvents = True
(and remove the other occurences).
This will make sure you don't call your macro while running it.
I am very new to vba coding .
In the worksheet I am trying to add an additional column using macros-column (Q)by checking conditions in simultaneous columns J,K,O).So if certain conditions pass in each of the columns I want a value to be entered in Q column for the respective row. This is the piece of code I put together .
Option Explicit
Sub Button2_Click()
Sheet1.Activate
Dim i As Long
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
'Check so that we only process non-empty cells
'(just in case there is an empty cell part-way through the data)
If Cells(i, 10).Value = "No" And Cells(i, 15) <= 0 Then
Cells(i, 17) = "Pending with employee"
Else
If Cells(i, 10).Value = "No" And Cells(i, 15) >= 0 And Cells(i, 11) = "No Action Pending" Then
Cells(i, 17) = "Pending with employee"
Else
If Cells(i, 10).Value = "No" And Cells(i, 15) >= 0 And Cells(i, 11) = "Pending With Manager" Then
Cells(i, 17) = "Pending with Manager"
Else
If Cells(i, 10).Value = "Yes" And Cells(i, 15) >= 0 And Cells(i, 11) = "No Action Pending" Then
Cells(i, 17) = "All Done"
'If Not IsEmpty(.Cells(i, "B").Value) Then
' If .Cells(i, "E").Value = "NA" Then'
'ThisWorkbook.Worksheets("CTCto TCC Conversion").Cells(i, "F").Value = "NA" '
End If
End If
End If
End If
Next i
End With
MsgBox "Column Created"
End Sub
It throws me an error Invalid or unqualified reference .Please help me if there any errors that need to be rectified for the code to run .
Thanks
Using the With Statement
BigBen has already answered your question. Here's an example with a little extra.
Check the two lines containing .Cells(i, 15).Value. One of them should probably have the equal sign removed.
If you write several conditions in one line of code, all of them will be evaluated even if the first one is already True (or False) making it less efficient than writing each condition in a new line. In practice, you most often won't feel a difference. I cannot decide which one is more readable or maintainable for you though.
Option Explicit
Sub Button2_Click()
With Sheet1
Dim i As Long
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, 10).Value = "No" Then
If .Cells(i, 15).Value <= 0 Then
.Cells(i, 17).Value = "Pending with employee"
Else
If .Cells(i, 11).Value = "No Action Pending" Then
.Cells(i, 17).Value = "Pending with employee"
ElseIf .Cells(i, 11).Value = "Pending With Manager" Then
.Cells(i, 17).Value = "Pending with Manager"
End If
End If
ElseIf .Cells(i, 10).Value = "Yes" Then
If .Cells(i, 15).Value >= 0 Then
If .Cells(i, 11).Value = "No Action Pending" Then
.Cells(i, 17).Value = "All Done"
End If
End If
End If
Next i
End With
MsgBox "Column Created"
End Sub
Application Match for one column works but for 2 columns is giving me error
With Sht
LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
For i = LastRow To 2 Step -1
DupRow = Application.Match(Cells(i, 9).Value, Range(Cells(1, 9), Cells(i - 1, 9)), 0)
DoEvents
If Not IsError(DupRow) Then
Cells(i, 8).Value = Cells(i, 8).Value + Cells(DupRow, 8).Value
Cells(i, 9).Value = Cells(i, 9).Value + Cells(DupRow, 9).Value
Rows(DupRow).Delete
End If
Next i
End With
for 2 columns Error runtime 1004
DupRow = Application.Match(Cells(i, 4).Value & Cells(i, 5).Value, Range(Cells(1, 4) & Cells(1, 5), Cells(i - 1, 4) & Cells(i - 1, 5)), 0)
What is the correct way of doing this?
In my opinion it's better to use dictionary for that, which has built-in method for managing keys, so it can be used to get unique values:
Sub teest()
Dim val As String
Set dict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
val = Cells(i, 1).Value & Cells(i, 2).Value
If dict.Exists(val) Then
Rows(i).Delete
Else
dict.Add val, 0
End If
Next
End Sub
The Sender (Consignor) and Receiver (Consignee) addresses are spread out in 3 different columns each. Hence I create 1 Consignor Address Column and 1 Consignee Address Column into which I want to concatenate the data.
Then I write 2 loops to go through and concatenate the values from the 3 cells.
The first loop works perfectly, while the second one does not really add the values, though when tested with F8 it does run the code so to say.
Can someone explain to me why that is?
Sub CnorCneeAddress()
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Consignee Address"
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "Consignor Address"
Dim Worksheet As Worksheet
Set Worksheet = ActiveSheet
LastRow = Worksheet.Cells(Worksheet.Rows.Count, "A").End(xlUp).Row
With Worksheet
For i = 2 To LastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 10 To 12
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 9).Value = Cells(i, 9).Value
ElseIf j = 12 Then
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value
Else
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
End With
With Worksheet
For i = 2 To LastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 14 To 16
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 17).Value = Cells(i, 17).Value
ElseIf j = 16 Then
Cells(i, 17).Value = Cells(i, 17).Value & Cells(i, j).Value
Else
Cells(i, 17).Value = Cells(i, 17).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
Columns("M:O").Delete
Columns("J:L").Delete
End With
End Sub
While the data for the Consignor is concatenated correctly, the cells under Consignor Address remain empty.
I do not understand why my code does not concatenate the cells for the Consignee Address.
thank you for your comments. Let me try to make things clearer.
I have data looking roughly so, after the column insertion, that is considered:
Columns 10, 11, 12 are "Consignor City", "Consignor State", "Consignor Post Code"
Column 14, 15, 16 are "Consignee City", Consignee State", "Consignee Post Code"
All variables are strings or integers e.g. if postcode in US..
Please see below picture.
Currently I have the code below running somewhat. I am working with VBA since 4 days, I have taken advanced Python before, so forgive me for still not understanding exactly how VBA works.
How the columns look
Sub CnorCneeAddress()
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Consignee Address"
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "Consignor Address"
Dim Worksheet As Worksheet
Set Worksheet = ActiveSheet
lastRow = Worksheet.Cells(Worksheet.Rows.Count, "C").End(xlUp).Row
With Worksheet
For i = 2 To lastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 10 To 12
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 9).Value = Cells(i, 9).Value
ElseIf j = 12 Then
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value
Else
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
End With
With Worksheet
For i = 2 To lastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 15 To 17
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 14).Value = Cells(i, 14).Value
ElseIf j = 17 Then
Cells(i, 14).Value = Cells(i, 14).Value & Cells(i, j).Value
Else
Cells(i, 14).Value = Cells(i, 14).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
Columns("O:Q").Delete
Columns("J:L").Delete
End With
End Sub
I have an excel workbook that consists of 5 worksheets that contain data and a 6th worksheet with a button that when clicked retrieves the data from the other 5 sheets to provide a combined view.
The data in the other 5 sheets is slightly different from each other, except for a few common columns so, I have to show the data in the combined view as one under the other with the country in row 1 and the headings in row 2 in bold text if possible for the data retrieved in each sheet.
I am able to run the macro via button to retrieve the data but I am not able to pull all the data in as required but for some reason, my code for setting the rows 1 and 2 for each sheet to bold is not working (code below shows me trying to get the first row to be set to bold).
One thing to keep in mind is that the amount of data on each sheet (the number of rows) may differ each time the macro is run.
Appreciate any help.
Option Compare Text
Sub OptionCompareText()
End Sub
Sub SearchMultipleSheets()
Dim arr(999, 14) As Variant, r As Range
Dim ws As Worksheet, i As Integer, s As String
With Sheets(1)
's = Range("b10").Value
.Range("a13").Resize(.UsedRange.Rows.Count, UsedRange.Columns.Count).ClearContents
End With
For Each ws In Worksheets
If ws.Name <> Sheets(1).Name Then
With ws
For Each r In .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
If r.Value & r.Offset(0, 1).Value & r.Offset(0, 2).Value & r.Offset(0, 3).Value & r.Offset(0, 4).Value _
& r.Offset(0, 5).Value & r.Offset(0, 6).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value _
& r.Offset(0, 9).Value & r.Offset(0, 10).Value & r.Offset(0, 11).Value & r.Offset(0, 12).Value & r.Offset(0, 13).Value _
Like "*" & s & "*" Then
'arr(i, 0) = ws.Name
arr(i, 0) = r.Value
arr(i, 1) = r.Offset(0, 1).Value
arr(i, 2) = r.Offset(0, 2).Value
arr(i, 3) = r.Offset(0, 3).Value
arr(i, 4) = r.Offset(0, 4).Value
arr(i, 5) = r.Offset(0, 5).Value
arr(i, 6) = r.Offset(0, 6).Value
arr(i, 7) = r.Offset(0, 7).Value
arr(i, 8) = r.Offset(0, 8).Value
arr(i, 9) = r.Offset(0, 9).Value
arr(i, 10) = r.Offset(0, 10).Value
arr(i, 11) = r.Offset(0, 11).Value
arr(i, 12) = r.Offset(0, 12).Value
arr(i, 13) = r.Offset(0, 13).Value
i = i + 1
End If
Next r
End With
End If
Next ws
With Sheets(1)
.Range("a13").Resize(i, 14).Value = arr
For Each ws In ActiveWorkbook.Worksheets
With ws.Rows(1)
.Font.Bold = True
End With
Next ws
End With
End Sub