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
This is a continuation for the following question: What is the cause for Conditional Formatting to get jumbled up?
In an attempt to prevent my conditional formatting from going haywire, I decided to convert it into code in VBA. I decided to start small and start with converting one conditional formatting into VBA.
Explanation:
In column O there are a series of numbers, obtained from a different sheet. User inputs number in column F. For example if number in F9 is less than O9, the font colour will become red. If not number remains normal. The formula should start at row 9 and can continue down onwards and should be automatic.
Meaning the moment a number is keyed in column F the font colour should change instantly.
The following is the code I created so far:
Sub change_color()
With Me.Range("f9", Range("f" & Rows.Count).End(xlUp)) 'so the formula will carry onwards from f9 onwards
If f9 < o9 Then
Range(f).Font.Color = vbRed
End If
End With
End Sub
But alas it didn't work. I also tried linking it to a button and nothing happens. And I also remember to remove my old conditional formatting as well. Is there something I'm missing?
You are after something like the code below.
This code is to be ran once, it will lopp through the entire column "F" in your worksheet, and change the font of all instances.
Regular Module Code
Option Explicit
Sub change_color()
Dim LastRow As Long, i As Long
With Worksheets("Sheet1") ' modify to your sheet's name
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = 1 To LastRow
If .Range("F" & i).Value < .Range("O" & i).Value Then
.Range("F" & i).Font.Color = vbRed
Else
.Range("F" & i).Font.Color = vbBlack
End If
Next i
End With
End Sub
To "catch" the modification in real-time, when someone changes a value in column "F", and then change the font according to the criteria you specified, you need add the following code to the Worksheet module, where you have your data, and add the piece of code below to Worksheet_Change event.
Code in Sheet1 module (modify to your sheet's)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then ' if someone changes a value in column "F"
Application.EnableEvents = False
If Target.Value < Range("O" & Target.Row).Value Then
Target.Font.Color = vbRed
Else
Target.Font.Color = vbBlack
End If
End If
Application.EnableEvents = True
End Sub
Does this work for you?
Option explicit
Sub ChangeColor()
With thisworkbook.worksheets(YOURSHEETNAME) 'Replace with sheet name as per your workbook.'
Dim LastRow as long
Lastrow = .cells(.rows.count,"F").end(xlup).row
Dim RowIndex as long
For rowindex = 9 to LastRow
If .cells(rowindex,"F").value2 < .cells(rowindex,"O").value2 then
.cells(rowindex,"F").font.color = vbred
End if
Next rowindex
End With
End Sub
I'm new to the community and I apologize if there is a thread elsewhere, but I could not find it!
I'm currently diving into VBA coding for the first time. I have a file that I dump into a worksheet that currently I'm manually organizing and pushing out. When put into the worksheet, it delimits itself across the cells. This dump file will have varying row and column lengths every time I get it in a given day and dump into a work sheet. For example, one day it may be twenty rows and one day it may be thirty.
A certain roadblock in my VBA code creation process has presented itself. I'm trying to create a code that will parse through the worksheet to remove any time a certain value appears (See below image - I'm referring to the (EXT)). After doing so I'm trying to concatenate the cells in the row up until there is a space (which with the rows that have (EXT), there usually isn't a space after until the (EXT) is removed).
The code I made works for now but I recognize it's not very efficient and not reliable if the names extend longer than two cells. I was hoping someone on here could provide me with guidance. So, I'm looking for two things:
For the code to scan the whole active used range of the table and remove (EXT). As it may appear in various columns.
A way to concatenate the cells in every row in the active range from A to the cell before a blank cell
Keep in mind I have no coding background, I'm learning and I'm not familiar with VBA terms and whatnot all that much just yet - so if you could please explain in laymen's terms I'd appreciate it. I hope all of this makes sense... Thanks in advance!
This is just an example of part of what the dump code looks like, so my code probably doesn't match with the example below - I just wanted to provide a visual:
http://i.imgur.com/IwDDoYd.jpg
The code I currently have:
Sub DN_ERROR_ORGANIZER()
' Removes any (EXT) in Column 3 in actual dump data file
For i = 200 To 1 Step -1
If (Cells(i, 3).value = "(EXT)") Then
Cells(i, 3).Delete Shift:=xlToLeft
End If
Next i
' Removes any (EXT) in Column 4 in actual dump data file
For j = 200 To 1 Step -1
If (Cells(j, 4).value = "(EXT)") Then
Cells(j, 4).Delete Shift:=xlToLeft
End If
Next j
' Removes any (EXT) in Column 5 in actual dump data file
For k = 200 To 1 Step -1
If (Cells(k, 5).value = "(EXT)") Then
Cells(k, 5).Delete Shift:=xlToLeft
End If
Next k
' Places a new column before A and performs a concatenate on cells B1 and C1 to
' form a name, then copies all through column A1 to repeat on each row
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "=PROPER(CONCATENATE(RC[1],"", "", RC[2]))"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A51")
Range("A1:A51").Select
End Sub
edited: to keep the comma after the first "name" only
this should do:
Sub main()
Dim cell As Range
With Worksheets("names")
With Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
For Each cell In .Rows
cell.Cells(1, 2).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(cell.Value)), " "), " ", " "), " (EXT)", ""), " ", ", ", , 1)
Next cell
.Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
.Columns(1).Value = .Columns(1).Value
.Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
End With
End With
End Sub
just remember to change "names" to you actual worksheet name
edited 2:
code for stopping cells to be processed at every line at the last one before the first blank one
Sub main()
Dim cell As Range, dataRng As Range
With Worksheets("names") '<--| change "names" to you actual worksheet name
Set dataRng = Intersect(.UsedRange, .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow)
For Each cell In dataRng.Columns(1).Cells
cell.Offset(, 1).Value = Replace(Replace(Replace(Join(Application.Transpose(Application.Transpose(.Range(cell, cell.End(xlToRight)).Value)), " "), " ", " "), " (EXT)", ""), " ", ", ", , 1)
Next cell
With dataRng
.Columns(1).FormulaR1C1 = "=PROPER(RC[1])"
.Columns(1).Value = .Columns(1).Value
.Offset(, 1).Resize(, .Columns.Count - 1).ClearContents
End With
End With
End Sub
I believe you are quite close to achieve what you are asking for and, based on your request, I will not give you a solution but some guidance to complete it by yourself.
First 3 loops: You could simplify by having a single set of nested loops: An outer loop running from 3 to 5, an inner loop running from 200 to 1; the outer loop will run over index, say "p", the inner over index, say "q", and your reference to cells would become Cells(q,p). If you need to run this over more than 3 rows, just start the outer loop from, say, 3 and till, say 10000 (being 10000 the maximal number of rows your data may display) and add a condition that if the first cell of the row is empty, you exit the outer loop.
The second part (this is what I understood) is to take the 2-3 first cells and concatenate them into a new cell (i.e. the column you add at the left). Once again, you can just loop over all your rows (much the same as in the outer loop mentioned above), except that now you will be looking at the cells in columns 2-4 (because you added a column at the left). The same exit condition as above can be used.
I'm not sure if this is what you were looking for, but this is what I understood you were looking for.
After reading user3598756's answer, I realized that I missed the boat with my original answer.
Sub DN_ERROR_ORGANIZER()
Dim Target As Range
Set Target = Worksheets("Sheet1").UsedRange
Target.Replace "(EXT)", ""
With Target.Offset(0, Target.Columns.Count).Resize(, 1)
.FormulaR1C1 = "=PROPER(C1&"", ""&TEXTJOIN("" "",TRUE,RC[-" & (Target.Columns.Count - 1) & "]:RC[-1]))"
.Value = .Value
End With
Target.Delete
End Sub
UPDATE
If you are running an older version of Excel that doesn't support TEXTJOIN then use this:
Sub DN_ERROR_ORGANIZER()
Dim Data
Dim x As Long, y As Long
Dim Target As Range
Dim Text As String
Set Target = Worksheets("Sheet1").UsedRange
Target.Replace "(EXT)", ""
Data = Target.Value
For x = 1 To Target.Rows.Count
Data(x, 1) = Data(x, 1)
For y = 2 To Target.Columns.Count
If Data(x, y) <> vbNullString Then Text = Text & " " & Data(x, y)
Next
If Len(Text) Then Data(x, 1) = Data(x, 1) & "," & Text
Text = vbNullString
Next
Target.ClearContents
Target.Columns(1).Value = Data
End Sub
I have a set of raw data on sheet 1 of my workbook. On sheet 2 I use formulas to pull in some of that data from sheet 1.
Using a Macro that I created and posted in Module 1 I want to hide any rows that do not contain specific data. I am able to execute the macro directly when I need to via Run>Run Sub/Userform. It works perfectly.
However, I would prefer it to run when it needs to update via a worksheet_change event in the background whenever an edit is made to sheet 1. Because I am making edits on sheet 1 but want the change to execute the macro on sheet 2 I understand that the worksheet_change event has to be placed in "This Worksheet" as opposed to the specific sheet.
Here's the macro code
Sub HideRows()
Dim i As Integer
i = 1
Do While Not Cells(i, 5) = ""
If Cells(i, 5).Value = 0 Then
Rows(CStr(i) + ":" + CStr(i)).EntireRow.Hidden = True
ElseIf Cells(i, 5).Value <> 0 And Rows(CStr(i) + ":" + CStr(i)).EntireRow.Hidden = True Then
Rows(CStr(i) + ":" + CStr(i)).EntireRow.Hidden = False
End If
i = i + 1
Loop
End Sub
Run directly the code above does what I need. The code I am using below to execute this via a worksheet_change event doesn't work.
Private Sub Worksheet_Change(ByVal Target As Range)
With Me.Worksheets("Sheet2")
Call HideRows
End With
End Sub
Any help with how to execute the macro using worksheet_change would be appreciated.
Few points worth noting
The problem is that you are not fully qualifying the cells so when the HideRows macro is called, even though you have used With Me.Worksheets("Sheet2") it is still referring to the current sheet which is Sheet1. Fully qualify your range objects as shown below. Notice the Dots before them?
If the changes are happening in Col A of Sheet1 then trap that else your macro will run for any change in Sheet1 thereby making your workbook slow.
You do not need to keep the macro in a module. You can put the entire code in Sheet1 as shown below
Also Rows(CStr(i) + ":" + CStr(i)) can be written as Rows(i)
When working with rows in Excel it is always advisable to declare them as Long and not Integer. Post Excel2007 the number of rows have increased and the Integer variable may not be able to accommodate that.
Is this what you are trying? Put this code in Sheet code area of Sheet1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, lRow As Long
'~~> Check of the change is happening in Col 1
If Not Intersect(Target, Columns(1)) Is Nothing Then
With Worksheets("Sheet2")
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If .Cells(i, 5).Value = 0 Then
.Rows(i).EntireRow.Hidden = True
ElseIf .Cells(i, 5).Value <> 0 And .Rows(i).EntireRow.Hidden = True Then
.Rows(i).EntireRow.Hidden = False
End If
Next i
End With
End If
End Sub
Maybe due to my poor English some of you may misunderstood what I wanted to do. Anyways, here is the code that I wanted. After many trial and errors I made it but I doubt its the best way but it works =). If anyone know how to make the code better please tell me =).
I previous post is also below this new code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row As Integer
For row = 1 To 1000
If Cells(row, "A").Value = "Yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
If Cells(row, "A").Value = "yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
Next row
End Sub
Previous post
I have written a VBA code in excel where I want to change a cell color everytime I write "yes". In this case I write "yes" in column E and column A should change color. I have used a for loop but it does not run as I want. I have a feeling I am thinking a bit wrong...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellNr As Long
For cellNr = 1 To 5
If Range("E" & cellNr).Value = "yes" Then
Range("A" & cellNr).Interior.ColorIndex = 5
Else
ActiveCell(0, -2).Interior.ColorIndex = 4
End If
Next cellNr
End Sub
Use conditional formatting with a formula. Starting in row 1 the formula required is
=$E1="yes"
If I understand what you are trying to do with the following line:
ActiveCell(0, -2).Interior.ColorIndex = 4
Replace it with:
ActiveCell.Offset(0, -2).Interior.ColorIndex = 4
As far as I know, the line I told you to remove will always throw an error. It doesn't make any sense syntactically. You should use the Offset function to get positions relative to the Active Cell. But also, this offset function will throw an error if your active cell is in column A or B because there are less than 2 columns to the left of the active cell.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rOfInterest As Range
Set rOfInterest = Range("E1:E5")
If Intersect(Target, rOfInterest) Is Nothing Then Exit Sub
v = Target.Value
If v = "yes" Then
Target.Offset(0, -4).Interior.ColorIndex = 5
Else
Target.Offset(0, -4).Interior.ColorIndex = 4
End If
End Sub
and make sure the macro is in the worksheet code area.