First View (FIRST SHEET FOR UPLOADING)
Second View (DATABASE WHERE DATA IS PARSED AND MANUAL EDITION IS BLOCKED
SUB I MADE FOR DATA VALIDATION AND PARSING INFO
Hi fellow devs,
This is my first time using VBA. Im stucked atm because i need to add some functionality i cant figure out. I need to modify my sub so if by any chance there is a duplicate row on the "UPLOAD" slide it wont paste again in my "BASE" and if there is the same line but QTY modified it should update to new QTY. Could you please help me figure out how to change my sub?
Tks and regards.
EDIT:
This is the SUB:
Sub Button_Click()
ThisWorkbook.Worksheets("UPLOAD").Range("C4", Cells(Rows.Count, 3).End(xlUp)).Interior.ColorIndex = xlNone
For Each c In Worksheets("UPLOAD").Range("C4", Cells(Rows.Count, 3).End(xlUp))
If (Len(c) <> 12) And (c <> "") Then
c.Interior.ColorIndex = 3
MsgBox ("Faltan 12ncs!! Porfavor agreguelos o corrija los que estén mal.")
Exit Sub
End If
Next c
a = Worksheets("UPLOAD").Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To a
Worksheets("UPLOAD").Rows(i).Copy
Worksheets("BASE").Activate
b = Worksheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("BASE").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("UPLOAD").Activate
Next
Application.CutCopyMode = False
Worksheets("UPLOAD").Cells(1, 1).Select
End Sub
Before Loop
Create an array
Loop through your items
Inside the loop
Check if id is inside the array, skip item
Add id to the array
Upload item
Related
I want to Copy and Paste Rows from one excel tab to another whenever a criteria is met. Currently, this is my code which I learnt from an online tutorial. Is there a way I can modify the code below to prevent overwriting and copying the same data twice whenever I click the button?
Private Sub CommandButton1_Click()
a = Worksheets("Results").Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To a
If Worksheets("Results").Cells(i, 29).Value = "Nutella" Then
Worksheets("Results").Rows(i).Copy
Worksheets("Nutella").Activate
b = Worksheets("Nutella").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Nutella").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Results").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Results").Cells(1, 1).Select
End Sub
Thanks
I want to copy all rows that have a specific value in column E and then insert them (NOT PASTE! so i want to insert new rows start at cell A29) on another sheet.
The sheet I want to copy from is called "owssvr" and the one I want to copy to is called "AOB Approval Form". I want to insert the copied rows starting Cell A29 in the "AOB Approval Form".
When i run the code, nothing happens. No error message pops up.
Few definition of my code below:
LastRow: The last row of the "owssvr" sheet
PrimaryAOB: value that i want to lookup for in column 5. It is on the "AOB Approval Form" sheet
Here is my code:
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
THANK YOU!
I copied your code into a new module in a blank workbook, then made the necessary mods to make it run (which it did). It looks the same as yours:
Sub Question()
Dim k As long, lastRow As Long
Dim primaryAOB As String
lastRow = Sheets(1).Range("E" & (ActiveSheet.Rows.Count)).End(xlUp).Row
primaryAOB = Sheets(2).Range("A1").Text
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
End Sub
Since this worked, you may have just had some little syntax error somewhere while defining the variables. show us more of your procedure, that may reveal the issue! Also, have you run your code line by line? (F8)
So I have a small bit of VBA code that I used to carryover rows of data in Excel based on some specific criteria. If column S contains "1" it copies the row to the next sheet. There are usually around 40 to 50 rows to copy of around 80 to 100 and the rows that get copied are not always contiguous, but when it pastes them in they are. The code works dynamically by using ActiveSheet.Next.
Sub FwdCases()
Dim strsearch As String, lastline As Integer, tocopy As Integer
Application.ScreenUpdating = False
Range("S:S").EntireColumn.Hidden = False
strsearch = "1"
lastline = Range("A200").End(xlUp).Row
j = 2
For i = 2 To lastline
For Each c In Range("S" & i & ":S" & i)
If InStr(c.Text, strsearch) Then
tocopy = 1
End If
Next c
If tocopy = 1 Then
Rows(i).Copy Destination:=ActiveSheet.Next.Rows(j)
j = j + 1
End If
tocopy = 0
Next i
ActiveSheet.Range("S:S").EntireColumn.Hidden = True
Application.ScreenUpdating = True
ActiveSheet.Next.Select
End Sub
This code works absolutely fine. Both in the editor and when called from a button. However I recently discovered that it was also copying & pasting a TON of extra conditional formatting (hundreds of redundancies), so I went to change the copy paste method to PasteSpecial xlPasteFormulas but apparently I've implemented it wrong, because now the code only works properly when called from the editor. When I run it using the button it only copies over 2 rows then jumps 2 sheets ahead (not 1) and stops.
I changed:
Rows(i).Copy Destination:=ActiveSheet.Next.Rows(j)
to:
ActiveSheet.Rows(i).Copy
ActiveSheet.Next.Rows(j).PasteSpecial xlPasteFormulas
Why is this simple change wreaking so much havoc?
EDIT: Expanded first paragraph.
Try explicitly referring to your sheet i.e.
Workbooks("Book1").Sheets("Sheet1").Rows(i).Copy
Workbooks("Book1").Sheets("Sheet1").Rows(j).PasteSpecial xlPasteFormulas
Agreeing with the comments below, I've removed the .Next from the syntax
Fixed it. Just needed to break up the code with Select and use Selection.PasteSpecial instead of ActiveSheet.Next.Rows(j).PasteSpecial. It now works properly even when called via a button.
ActiveSheet.Rows(i).Copy
ActiveSheet.Next.Select
Rows(j).EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormulas
ActiveSheet.Previous.Select
i'm fairly new to VBA and could do with a bit of help. I've looked online and i've found a few bits of code but have been unable to amend to my needs.
I'm trying to create a macro that will enable me to see if their are any duplicate text between column A and B and if the text in column A matches Column B then we will need to delete the entire row. The columns are on the same sheet
I am trying to create a loop that will do this. I must also point out that the length of the list does increase every week
I would appreciate any help
Thank you
Hi try in your code VBA:
Sub DeleteRowWithContents()
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Record Only" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
you can update this code for your problem!
I use this when i need deletes all rows from a2 downwards with the words "record only" in column d.
Maybe try this:
Sub DeleteRowWithContents()
Dim ColumnAValue As String
Dim ColumnBValue As String
Dim xlWB As Worksheet
Set xlWB = ActiveWorkbook.ActiveSheet 'If it isn't the active sheet use second row:
'Set xlWB = ActiveWorkbook.Sheets("NameOfSheet") 'Change to the name of your sheet
For i = 1 To EOF 'This goes through the whole document to the last row automatically, EOF means "End Of File"
ColumnAValue = xlWB.Cells(i, 1).Value 'row i, column "a"
ColumnBValue = xlWB.Cells(i, 2).Value 'row i, column "b"
If (ColumnAValue = ColumnBValue) Then
xlWB.Range(ColumnAValue).Select
Selection.EntireRow.Delete 'NOTE!!
End If
Next i
End Sub
NOTE: I'm not too sure if this works, can't test it right now. IF it doesn't, try this instead:
EntireRow.Select
Selection.Delete
I've been working on a project and I'm trying to make things go smoother :)
I have an excel sheet with several columns and as you can see it below, Column C is the importance of the topic(based on information typed in that row) and Column D is whether the information typed is a new information or an update regarding the previous (upper) row. Soo:
if I type "update" on column D, row 3; I want it to automatically merge the cells C2 and C3.
C D
1 LOW new
2 HIGH new
3 update
4 Low new
5 update
6 update
I don't know how to write VBA codes but I can mostly understand the codes enough to adopt what I find on internet to what I want to achieve. I have checked so many websites to find whatever I needed but I had no luck so I would really appreciate if you could help me :)
Try this :
Sub Merge_Priority()
Dim RgToMerge As String
For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
RgToMerge = ""
If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
Else
RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
With Range(RgToMerge)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
Next i
End Sub
Do you know how to add a macro on an event?
Go to Visual Studio, select ThisWorkBook on the left and create a macro with this :
Private Sub Worksheet_Change()
And paste the code right above
You can try something like this add this Macro in the Current Sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
IF Target.value = "Update" then
Range("A" & Target.row - 1 & ":A" & Target.row).Merge
End If
End Sub