I have code which is used for concatenation. The cells are dynamic; whenever a change in cells in a range the concatenation function will automatically execute and gives the value. Currently I asked the concatenation function which has to run for the complete range even though the modification is in a single row. Which is causing a lot of time during the execution.
Is there is any way to define to update only a single row that is modified? I know the technique if the range is single column, for multiple columns I didn't have any idea.
My Code
ColumnLetter3 = Split(Cells(1, c1_column).Address, "$")(1)
ColumnLetter4 = Split(Cells(1, c6_column).Address, "$")(1)
Range3 = ColumnLetter3 & st_workrow2 + 1 & ":" & ColumnLetter4 & last_cell1
Set xrng3 = Range(Range3)
If Not Application.Intersect(xrng3, Range(Target.Address)) _
Is Nothing Then
For i = c_row + 1 To last_cell1
If Cells(i, c1_column) = "" And Cells(i, c2_column) = "" And Cells(i, c3_column) = "" And Cells(i, c4_column) = "" And Cells(i, c5_column) = "" And Cells(i, c6_column) = "" Then
Cells(i, c_column) = ""
Else
Cells(i, c_column) = Cells(i, c1_column) & "-" & Cells(i, c2_column) & "-" & Cells(i, c3_column) & "-" & Cells(i, c4_column) & "-" & Cells(i, c5_column) & "-" & Cells(i, c6_column)
Cells(i, c_column).Replace what:="+", Replacement:=""
Cells(i, c_column).Replace what:="-----", Replacement:="-"
Cells(i, c_column).Replace what:="----", Replacement:="-"
Cells(i, c_column).Replace what:="---", Replacement:="-"
Cells(i, c_column).Replace what:="--", Replacement:="-"
If Right(Cells(i, c_column), 1) = "-" Then
l = Len(Cells(i, c_column))
Cells(i, c_column) = Left(Cells(i, c_column), l - 1)
End If
If Left(Cells(i, c_column), 1) = "-" Then
l = Len(Cells(i, c_column))
Cells(i, c_column) = Right(Cells(i, c_column), l - 1)
End If
End If
Next I
Endif
It's hard to tell exactly what you're doing here (perhaps strip down your question?), however looks like you want to get a list of the rows in your target? In that case you can isolate it using Columns(1). See below...
If Not Application.Intersect(xrng3, Range(Target.Address)) _
Is Nothing Then
Dim aCell As Range
For Each aCell In Target.Columns(1).Cells
i = aCell.Row
If Cells(i, c1_column) = "" And Cells(i, c2_column) = "" And Cells(i, c3_column) = "" And Cells(i, c4_column) = "" And Cells(i, c5_column) = "" And Cells(i, c6_column) = "" Then
'skipped....
End If
Next aCell
End If
Related
I am currently working on a multiple if, I would like to avoid writing 100 "OR" in my code and therefore I have a list of criterias (AO450 to AO515) and I would like to have something like this : If the cells(i, 33) like one of the criterias, then "comment", your help would be very welcomed :)
Sub MultipleIf()
For i = 3 To 467
If Cells(i, 19).Value > 5000 Then
If Cells(i, 33).Value Like "*" & "Cells(AO450:AO515).Value" & "*" Then
Cells(i, 35).Value = "commentA"
ElseIf Cells(i, 19).Value > 0 And Cells(i, 33).Value Like "*" & "ABC" & "*" Then
Cells(i, 35).Value = "commentB"
ElseIf Cells(i, 19).Value > 0 And Cells(i, 33).Value Like "*" & "DEF" & "*" Then
Cells(i, 35).Value = "commentC"
Else
Cells(i, 35).Value = "commentD"
End If
ElseIf Cells(i, 19).Value < -5000 Then
If Cells(i, 33).Value Like "*" & "Cells(AO450:AO515).Value" & "*" Then
Cells(i, 35).Value = "commentAA"
ElseIf Cells(i, 19).Value < 0 And Cells(i, 33).Value Like "*" & "ABC" & "*" Then
Cells(i, 35).Value = "commentBB"
ElseIf Cells(i, 19).Value < 0 And Cells(i, 33).Value Like "*" & "DEF" & "*" Then
Cells(i, 35).Value = "commentC"
Else
Cells(i, 35).Value = "commentD"
End If
Else:
If Cells(i, 19).Value < 0 And Cells(i, 33).Value Like "*" & "GHI" & "*" Then
Cells(i, 35).Value = "commentE"
Cells(i, 36).Value = "commentF"
Else
Cells(i, 35).Value = "commentD"
End If
End If
Next
End Sub
EDIT - updated to add full (reworked) code
If you want to test whether a value is found in a single-column range then you can do something like this:
Sub MultipleIf()
'come up with some better variable names than `v19` and `v33`...
Dim ws As Worksheet, i As Long, rw As Range, v19, v33 As String, rngList As Range, txt
Set ws = ActiveSheet
Set rngList = ws.Range("AO450:AO515")
For i = 3 To 467
Set rw = ws.Rows(i)
v19 = rw.Cells(19).Value
v33 = rw.Cells(33).Value
txt = ""
If v19 > 5000 Then
Select Case True 'https://stackoverflow.com/questions/794036/select-case-true
Case ColumnContains(rngList, v33): txt = "commentA"
Case v33 Like "*ABC*": txt = "commentB"
Case v33 Like "*DEF*": txt = "commentC"
Case Else: txt = "commentD"
End Select
ElseIf v19 < -5000 Then
Select Case True
Case ColumnContains(rngList, v33): txt = "commentAA"
Case v33 Like "*ABC*": txt = "commentBB"
Case v33 Like "*DEF*": txt = "commentC"
Case Else: txt = "commentD"
End Select
Else
If v19 < 0 And v33 Like "*GHI*" Then
txt = "commentE"
rw.Cells(36).Value = "commentF"
Else
txt = "commentD"
End If
End If
If Len(txt) > 0 Then rw.Cells(35).Value = txt
Next
End Sub
'does a (single-column) range `rng` contain the string `txt`?
Function ColumnContains(rng As Range, txt As String) As Boolean
ColumnContains = Not IsError(Application.Match("*" & txt & "*", rng, 0))
End Function
The table contains column G = City, H = Department and J = Date. In the columns J Date some values are missing. I want to output these rows on a new worksheet with (column A) the rownumber, (column B) the city and (column) the departement.
The code I have looks like this but in the output all rows with a value in J = Date and the output is in the columns "G, H, J". I tried to change the columns in the code but I failed.
Sub missing()
Dim ws, wsOut As Worksheet
Set ws = ActiveWorkbook.Sheets("Table1")
Set wsOut = ActiveWorkbook.Sheets("output")
lastRow = ws.Range("G" & Rows.Count).End(xlUp).Row
lastRowOut = wsOut.Range("G" & Rows.Count).End(xlUp).Row + 1
For i = 1 To lastRow
If (ws.Cells(i, 10).Value = "") _
And _
((ws.Cells(i, 7).Value = "Peking") Or _
(ws.Cells(i, 7).Value = "Tokio") Or _
(ws.Cells(i, 7).Value = "London") Or _
(ws.Cells(i, 7).Value = "Rom") Or _
(ws.Cells(i, 7).Value = "Lissabon") Or _
(ws.Cells(i, 7).Value = "Panama") Or _
(ws.Cells(i, 7).Value = "Budapest") Or _
(ws.Cells(i, 7).Value = "Prag") Or _
(ws.Cells(i, 7).Value = "Dublin") Or _
(ws.Cells(i, 7).Value = "Luxemburg")) _
And _
((ws.Cells(i, 8).Value = "A") Or _
(ws.Cells(i, 8).Value = "B") Or _
(ws.Cells(i, 8).Value = "C") Or _
(ws.Cells(i, 8).Value = "D") Or _
(ws.Cells(i, 8).Value = "E") Or _
(ws.Cells(i, 8).Value = "F") Or _
(ws.Cells(i, 8).Value = "G") Or _
(ws.Cells(i, 8).Value = "H") Or _
(ws.Cells(i, 8).Value = "I") Or _
(ws.Cells(i, 8).Value = "J")) _
Then
wsOut.Range("B" & lastRowOut & ":C" & lastRowOut).Value = ws.Range("G" & i & ":H" & i).Value
wsOut.Range("A" & lastRowOut).Value = i
lastRowOut = lastRowOut + 1
End If
Next i
End Sub
while i was writing this others have answered and honestly I like there solution but can also be done like this:
Sub missing()
Dim ws, wsOut As Worksheet
Set ws = ActiveWorkbook.Sheets("table")
Set wsOut = ActiveWorkbook.Sheets("output")
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastRowOut = wsOut.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lastRow
If ws.Cells(i, 3).Value = "" Then
wsOut.Range("A" & lastRowOut & ":B" & lastRowOut).Value = ws.Range("A" & i & ":B" & i).Value
wsOut.Range("C" & lastRowOut).Value = i
lastRowOut = lastRowOut + 1
End If
Next i
End Sub
assuming table is in worksheet "table" and output is wanted in a worksheet called "output" [note output has to have a value somewhere in column A before the code is run or an error will be thrown]
Also the code you show does not appear to be trying to answer the question you've asked, it may just be that you took a wrong turn but it is quite different, let us know if we've all missed the point!
Click on cell "A1", press Ctrl+G and choose "Special", "current region" (that should select the whole array). Again press Ctrl+G and choose "Special", this type choose "Blanks".
In the address bar, type "No Date".
Press Ctrl+ENTER (don't forget the control-button).
You can record this into a macro.
Have fun :-)
Oh, by the way, this is wrong:
If Cells(i, 1).Value = "Peking" Or "Tokio" Or "London" Or ...
It should be something like:
If Cells(i, 1).Value = "Peking" Or_
Cells(i, 1).Value = "Tokio" Or_
...
(The underscore after "Or" is just to explain VBA that this should be treated as one single line.)
Not sure i'm 100% with you, but
Dim r as range
dim c as range
dim a() as variant
dim i as long
set r=range("c2:c22").specialcells(xlcelltypeblanks)
redim a(1 to r.cells.count,1)
i=1
for each c in r.cells
a(i,0) = cells(c.row,1)
a(i,1)=cells(c.row,2)
i=i+1
next c
' Output, to j1 on the same sheet.
cells(1,10).resize(ubound(a),2).value=a
The code takes information from another range of cells in the same sheet ("Non Order RAW Detail Report") and creates a new one beside it using data from the one to the left.
My code takes from 45 minutes to an hour for 70k rows of cells. Is there a way to make the loops go faster?
Sub cruzar()
Dim i As Long
Dim last As Long
Dim user As String
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets("Non Order RAW Detail Report").Select
last = ActiveSheet.UsedRange.Rows.Count
'-------------Cruzar--------------------------------
Range("W1").Value = "Year"
Range("x1").Value = "Month"
Range("y1").Value = "Creation Date"
Range("z1").Value = "Closed Date"
Range("AA1").Value = "Type Inquiry"
Range("AB1").Value = "Value"
Range("AC1").Value = "Status"
Range("AD1").Value = "Equal Month"
Range("AE1").Value = "Days"
Range("AF1").Value = "Bracket"
Range("W1:AF1").Interior.ColorIndex = 49
Range("W1:AF1").Font.Color = vbWhite
Range("W1:AF1").Font.Bold = True
user = Environ("username")
For i = 2 To last
Cells(i, 23).Value = Cells(i, 15).Value
Cells(i, 23).NumberFormat = "yyyy"
Cells(i, 24).Value = Cells(i, 15).Value
Cells(i, 24).NumberFormat = "mm"
Cells(i, 25).Value = Cells(i, 15).Value
Cells(i, 25).NumberFormat = "mm/dd/yyyy"
Cells(i, 26).Value = Cells(i, 16).Value
Cells(i, 26).NumberFormat = "mm/dd/yyyy"
Cells(i, 27).Formula = "=VLOOKUP(N" & i & ",'C:\Users\" & user & "\Desktop\Americas\00 Inputs\[CategoryList_NAM_v2.xlsx]CATEGORIES'!$I:$J,2,0)"
Cells(i, 28) = 1
If Cells(i, 5).Value = "FCR" Then
Cells(i, 29).Value = "FCR"
Else
Cells(i, 29).Value = "Follow Up"
End If
Cells(i, 30).Formula = "=IF(E" & i & "=""FCR"",""FCR"",IF(AND(MONTH(O" & i & ")=MONTH(P" & i & "),YEAR(O" & i & ")=YEAR(P" & i & ")),""Closed"",""Open""))"
Cells(i, 31).Formula = "=IF(E" & i & "=""FCR"",""FCR"",IF(AD" & i & "=""Open"",""Open"",IF(((P" & i & "-O" & i & ")*24)<24,0,LOOKUP(((P" & i & "-O" & i & ")*24),'C:\Users\" & user & "\Desktop\Americas\00 Inputs\[1610_InputsDB.xlsx]Input'!$A$2:$B$366,'C:\Users\" & user & "\Desktop\Americas\00 Inputs\[1610_InputsDB.xlsx]Input'!$C$2:$C$366))))"
Cells(i, 32).Formula = "=IF(AE" & i & "=""FCR"",""FCR"",IF(AE" & i & "=""Open"",""Open"",LOOKUP(AE" & i & ",'C:\Users\" & user & "\Desktop\Americas\00 Inputs\[1610_InputsDB.xlsx]Input'!$E$2:$F$9,'C:\Users\" & user & "\Desktop\Americas\00 Inputs\[1610_InputsDB.xlsx]Input'!$G$2:$G$9)))"
Next
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
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
I'm having trouble with this sequence of if statements. The error I'm getting is: Object required. I'm just going to give the relevant area of the code, please assume all variables are properly defined.
For i = 6 To LastRow
If Cell.Value("$I" & i) = "" Then
Cell.Value("$I" & i) = Format(Now(), "MMM-DD-YYYY")
ElseIf Cell.Value("$N" & i) = "" Then
Cell.Value("$I" & i) = Application.WorksheetFunction.WorkDay("$J" & i + "$L" & i - 1, 1)
End If
Next i
I'm having trouble getting the workday function to work properly. Any ideas?
Let's try to add some fixes:
For i = 6 To LastRow
If Cells( i, "I").Value = "" Then
Cells( i, "I").Value = Format(Now(), "MMM-DD-YYYY")
ElseIf Cells( i, "N").Value = "" Then
Cells( i, "I").Value = Format(Application.WorksheetFunction.WorkDay(Cells(i, "J").Value, 1), "MMM-DD-YYYY")
End If
Next i